base64x.c Type Function Source Line STATIC CHAR * base64enc( char *s, size_t s_len )
static char * base64enc( char *s, size_t s_len )
{
char b64chars[] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
char * t;
char * p;
int x, y;
int len;
if( s_len > ( size_t ) INT_MAX )
{
return NULL ; /* die("data too long in base64enc()"); */
}
len = ( int ) s_len;
t = ( char * ) hb_xgrab( ( 4 * ( ( len + 2 ) / 3 ) + 1 ) * sizeof( char ) );
p = t;
while( len-- > 0 )
{
x = *s++;
*p++ = b64chars[(x >> 2) & 63];
if( len-- <= 0 )
{
*p++ = b64chars[(x << 4) & 63];
*p++ = '=';
*p++ = '=';
break;
}
y = *s++;
*p++ = b64chars[((x << 4) | ((y >> 4) & 15)) & 63];
if( len-- <= 0 )
{
*p++ = b64chars[(y << 2) & 63];
*p++ = '=';
break;
}
x = *s++;
*p++ = b64chars[((y << 2) | ((x >> 6) & 3)) & 63];
*p++ = b64chars[x & 63];
}
*p = '\0';
return t;
}
base64x.c 66 HB_FUNC BUILDUSERPASSSTRING(void)
HB_FUNC( BUILDUSERPASSSTRING )
{
char * s;
char * szUser = hb_parcx( 1 );
char * szPass = hb_parcx( 2 );
size_t p_len = strlen( szPass );
size_t u_len = strlen( szUser );
s = ( char * ) hb_xgrab( ( u_len + p_len + 3 ) * sizeof( char ) );
s[0] = '\0';
strcpy( s + 1, szUser );
strcpy( s + u_len + 2, szPass );
hb_retc_buffer( s );
}
base64x.c 111 HB_FUNC HB_BASE64(void)
HB_FUNC( HB_BASE64 )
{
char * szItem = hb_parc( 1 );
int nLen = hb_parni( 2 );
char * szRet = szItem ? base64enc( szItem, nLen ) : NULL;
if( szRet )
hb_retc_buffer( szRet );
else
hb_retc( NULL );
}
base64x.c 127 encmthd.c Type Function Source Line HB_FUNC TIPENCODERBASE64_ENCODE(void)
HB_FUNC( TIPENCODERBASE64_ENCODE )
{
char *cData = hb_parc( 1 );
char *cRet;
int nLen = hb_parclen( 1 );
int nPos = 0, nPosRet = 0;
int nPosBlock = 0, nLineCount = 0;
ULONG nFinalLen;
unsigned char cElem, cElem1;
BOOL bExcept;
if( ! cData )
{
hb_errRT_BASE( EG_ARG, 3012, NULL,
HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
if( ! nLen )
{
hb_retc( NULL );
return;
}
/* read the status of bHttpExcept */
if( hb_pcount() > 1 )
{
/* this makes this function static!!!! */
bExcept = hb_parl( 2 );
}
else
{
hb_objSendMsg( hb_stackSelfItem(), "BHTTPEXCEPT", 0 );
bExcept = hb_parl( -1 );
}
/* we know exactly the renturned length. */
nFinalLen = (ULONG) ((nLen / 3 + 2) * 4);
/* add line termination padding, CRLF each 76 output bytes */
nFinalLen += (nFinalLen / 72 +1) * 2;
cRet = ( char * ) hb_xgrab( nFinalLen );
while( nPos < nLen )
{
cElem = (unsigned char) cData[ nPos ];
/* NOT using trailing 0 here as some buggy 3dparty func
will create strings without trailing 0. */
nPosBlock++;
switch( nPosBlock )
{
case 1:
cElem = cElem >> 2;
break;
case 2:
cElem1 = nPos < nLen -1 ? (unsigned char) cData[ nPos + 1] : 0;
cElem = ((cElem & 0x3) << 4) | (cElem1 >> 4);
nPos++;
break;
case 3:
cElem1 = nPos < nLen -1 ? (unsigned char) cData[ nPos + 1] : 0;
cElem = ((cElem & 0xF) << 2) | (cElem1 >> 6);
nPos++;
break;
case 4:
cElem = cElem & 0x3f;
nPos++;
nPosBlock = 0;
break;
}
if( cElem < 26 )
{
cRet[nPosRet++] = cElem + 'A';
}
else if( cElem < 52 )
{
cRet[nPosRet++] = ( cElem - 26 ) + 'a';
}
else if( cElem < 62 )
{
cRet[nPosRet++] = ( cElem - 52 ) + '0';
}
else if( cElem == 62 )
{
cRet[nPosRet++] = '+';
}
else
{
cRet[nPosRet++] = '/';
}
if( ! bExcept )
{
nLineCount ++ ;
/* RFC says to add a CRLF each 76 chars, but is pretty unclear about
the fact of this 76 chars counting CRLF or not. Common
practice is to limit line size to 72 chars */
if( nLineCount == 72 )
{
cRet[nPosRet++] = '\r';
cRet[nPosRet++] = '\n';
nLineCount = 0;
}
}
}
switch( nPos % 3 )
{
case 1:
cRet[ nPosRet++ ] = '=';
/* fallthrough */
case 2:
cRet[ nPosRet++ ] = '=';
/* fallthrough */
}
/* RFC is not explicit, but CRLF SHOULD be added at bottom
during encoding phase */
if( ! bExcept )
{
cRet[nPosRet++] = '\r';
cRet[nPosRet++] = '\n';
}
/* this function also adds a zero */
hb_retclen_buffer( cRet, nPosRet );
}
encmthd.c 60 HB_FUNC TIPENCODERBASE64_DECODE(void)
HB_FUNC( TIPENCODERBASE64_DECODE )
{
char *cData = hb_parc( 1 );
unsigned char *cRet;
int nLen = hb_parclen( 1 );
int nPos = 0, nPosRet = 0, nPosBlock = 0;
unsigned char cElem;
if( ! cData )
{
hb_errRT_BASE( EG_ARG, 3012, NULL,
HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
if( ! nLen )
{
hb_retc( NULL );
return;
}
/* we know exactly the renturned length. */
cRet = ( unsigned char * ) hb_xgrab( (nLen / 4 + 1) * 3 );
while( nPos < nLen )
{
cElem = cData[ nPos ];
if( cElem >= 'A' && cElem <= 'Z' )
{
cElem -= 'A';
}
else if( cElem >= 'a' && cElem <= 'z' )
{
cElem = cElem - 'a' + 26;
}
else if( cElem >= '0' && cElem <= '9' )
{
cElem = cElem - '0' + 52;
}
else if( cElem == '+' )
{
cElem = 62;
}
else if( cElem == '/' )
{
cElem = 63;
}
/* end of stream? */
else if( cElem == '=' )
{
break;
}
/* RFC 2045 specifies characters not in base64 must be ignored */
else
{
nPos++;
continue;
}
switch( nPosBlock )
{
case 0:
cRet[nPosRet] = cElem << 2;
nPosBlock++;
break;
case 1:
/* higer bits are zeros */
cRet[nPosRet] |= cElem >> 4;
nPosRet++;
cRet[nPosRet] = cElem << 4;
nPosBlock++;
break;
case 2:
/* higer bits are zeros */
cRet[nPosRet] |= cElem >> 2;
nPosRet++;
cRet[nPosRet] = cElem << 6;
nPosBlock++;
break;
case 3:
cRet[nPosRet] |= cElem;
nPosRet++;
nPosBlock = 0;
break;
}
nPos++;
}
/* this function also adds a zero */
/* hopefully reduce the size of cRet */
cRet = ( unsigned char * ) hb_xrealloc( cRet, nPosRet + 1 );
hb_retclen_buffer( ( char * ) cRet, nPosRet );
}
encmthd.c 189 HB_FUNC TIPENCODERQP_ENCODE(void)
HB_FUNC( TIPENCODERQP_ENCODE )
{
char *cData = hb_parc( 1 );
int nLen = hb_parclen( 1 );
char *cRet;
unsigned char cElem;
int nVal, iLineLen = 0;
int nPosRet = 0, nPos = 0;
if( ! cData )
{
hb_errRT_BASE( EG_ARG, 3012, NULL,
HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
if( ! nLen )
{
hb_retc( NULL );
return;
}
/* Preallocating maximum possible length */
cRet = ( char * ) hb_xgrab( nLen * 3 + ( nLen/72 ) *3 + 3 );
/* last +3 is trailing \r\n\0 */
while( nPos < nLen )
{
cElem = (unsigned char) cData[ nPos ];
/* We chose not to encode spaces and tab here.
cElem is signed and ranges from -126 to +127.
negative values are automatically encoded */
if( (cElem >=33 && cElem <= 60) || cElem >= 62 ||
cElem == 9 || cElem == 32 )
{
cRet[nPosRet++] = (char) cElem;
iLineLen++;
}
else
{
cRet[nPosRet++] = '=';
nVal = cElem >> 4;
cRet[nPosRet++] = (char) (nVal < 10 ? '0' + nVal : 'A' + nVal - 10);
nVal = cElem & 0x0f;
cRet[nPosRet++] = (char) (nVal < 10 ? '0' + nVal : 'A' + nVal - 10);
iLineLen+=3;
}
nPos++;
if( iLineLen >= 72 )
{
cRet[nPosRet++] = '=';
cRet[nPosRet++] = '\r';
cRet[nPosRet++] = '\n';
iLineLen = 0;
}
}
/* Securing last line trailing space, if needed */
cElem = (unsigned char) cRet[nPosRet - 1];
if( cElem == 9 || cElem == 32 )
{
cRet[nPosRet++] = '=';
cRet[nPosRet++] = '\r';
cRet[nPosRet++] = '\n';
}
/* Adding canonical new line for RFC2045 blocks */
/* this function also adds a zero */
cRet = ( char * ) hb_xrealloc( cRet, nPosRet + 1 );
hb_retclen_buffer( cRet, nPosRet );
}
encmthd.c 286 HB_FUNC TIPENCODERQP_DECODE(void)
HB_FUNC( TIPENCODERQP_DECODE )
{
char *cData = hb_parc( 1 );
int nLen = hb_parclen( 1 );
char *cRet;
int nPos = 0, nPosRet = 0, nVal;
unsigned char cElem, cCipher;
if( ! cData )
{
hb_errRT_BASE( EG_ARG, 3012, NULL,
HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
if( ! nLen )
{
hb_retc( NULL );
return;
}
/* allocate maximum possible lenght. */
cRet = ( char * ) hb_xgrab( nLen + 1 );
while( nPos < nLen )
{
cElem = (unsigned char) cData[ nPos ];
if( cElem == '=' )
{
if( nPos < nLen - 2 )
{
cCipher = (unsigned char) cData[ ++nPos ];
/* soft line break */
if( cCipher == '\r' )
{
nPos += 2;
continue;
}
else {
nVal = cCipher >= 'A' && cCipher <= 'F' ? cCipher - 'A' + 10 :
cCipher - '0';
nVal *= 16;
cCipher = (unsigned char) cData[ ++nPos ];
nVal += cCipher >= 'A' && cCipher <= 'F' ? cCipher - 'A' + 10 :
cCipher - '0';
cRet[ nPosRet++ ] = (char) nVal;
}
}
/* else the encoding is malformed */
else
{
if(nPosRet > 0 )
{
break;
}
}
}
else
{
cRet[ nPosRet++ ] = (char) cElem;
}
nPos ++;
}
/* this function also adds a zero */
/* hopefully reduce the size of cRet */
cRet = ( char * ) hb_xrealloc( cRet, nPosRet + 1 );
hb_retclen_buffer( cRet, nPosRet );
}
encmthd.c 360 HB_FUNC TIPENCODERURL_ENCODE(void)
HB_FUNC( TIPENCODERURL_ENCODE )
{
char *cData = hb_parc( 1 );
int nLen = hb_parclen( 1 );
BOOL bComplete = hb_parl( 2 );
char *cRet;
int nPos = 0, nPosRet = 0, nVal;
char cElem;
if( hb_pcount() < 2 )
{
bComplete = TRUE;
}
if( ! cData )
{
hb_errRT_BASE( EG_ARG, 3012, NULL,
HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
if( ! nLen )
{
hb_retc( NULL );
return;
}
/* Giving maximum final length possible */
cRet = ( char * ) hb_xgrab( nLen * 3 + 1 );
while( nPos < nLen )
{
cElem = cData[ nPos ];
if( cElem == ' ' )
{
cRet[ nPosRet ] = '+';
}
else if(
(cElem >= 'A' && cElem <= 'Z') ||
(cElem >= 'a' && cElem <= 'z') ||
(cElem >= '0' && cElem <= '9') ||
cElem == '.' || cElem == ',' || cElem == '&' ||
cElem == '/' || cElem == ';' || cElem =='_' )
{
cRet[ nPosRet ] = cElem;
}
else if( ! bComplete && ( cElem == ':' || cElem == '?' || cElem == '=' ) )
{
cRet[ nPosRet ] = cElem;
}
else /* encode! */
{
cRet[ nPosRet++ ] = '%';
nVal = ( ( unsigned char ) cElem ) >> 4;
cRet[ nPosRet++ ] = nVal < 10 ? '0' + ( char ) nVal : 'A' + ( char ) nVal - 10;
nVal = ( ( unsigned char ) cElem ) & 0x0F;
cRet[ nPosRet ] = nVal < 10 ? '0' + ( char ) nVal : 'A' + ( char ) nVal - 10;
}
nPosRet++;
nPos++;
}
hb_retclen_buffer( cRet, nPosRet );
}
encmthd.c 436 HB_FUNC TIPENCODERURL_DECODE(void)
HB_FUNC( TIPENCODERURL_DECODE )
{
char *cData = hb_parc( 1 );
int nLen = hb_parclen( 1 );
char *cRet;
int nPos = 0, nPosRet = 0;
char cElem;
if( ! cData )
{
hb_errRT_BASE( EG_ARG, 3012, NULL,
HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
if( ! nLen )
{
hb_retc( NULL );
return;
}
/* maximum possible lenght */
cRet = ( char * ) hb_xgrab( nLen );
while( nPos < nLen )
{
cElem = cData[ nPos ];
if( cElem == '+' )
{
cRet[ nPosRet ] = ' ';
}
else if( cElem == '%' )
{
if( nPos < nLen - 2 )
{
cElem = cData[ ++nPos ];
cRet[ nPosRet ] = cElem < 'A' ? cElem - '0' : cElem - 'A' + 10;
cRet[ nPosRet ] *= 16;
cElem = cData[ ++nPos ];
cRet[ nPosRet ] |= cElem < 'A' ? cElem - '0' : cElem - 'A' + 10;
}
else
{
if( nPosRet > 0 )
{
break;
}
}
}
else
{
cRet[ nPosRet ] = cElem;
}
nPos++;
nPosRet++;
}
/* this function also adds a zero */
/* hopefully reduce the size of cRet */
cRet = ( char * ) hb_xrealloc( cRet, nPosRet + 1 );
hb_retclen_buffer( cRet, nPosRet );
}
encmthd.c 503 utils.c Type Function Source Line HB_FUNC TIP_TIMESTAMP(void)
HB_FUNC( TIP_TIMESTAMP )
{
PHB_ITEM pDate = hb_param( 1, HB_IT_DATE );
ULONG ulHour = hb_parl(2);
int nLen;
TIME_ZONE_INFORMATION tzInfo;
LONG lDate;
int iYear, iMonth, iDay;
const char *days[] = { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
const char *months[] = {
"Jan", "Feb", "Mar",
"Apr", "May", "Jun",
"Jul", "Aug", "Sep",
"Oct", "Nov", "Dec" };
char *szRet = (char *) hb_xgrab( 64 );
SYSTEMTIME st;
if ( !ulHour )
{
ulHour = 0;
}
if ( GetTimeZoneInformation( &tzInfo ) == TIME_ZONE_ID_INVALID )
{
tzInfo.Bias = 0;
}
else
{
tzInfo.Bias -= tzInfo.Bias;
}
if ( !pDate )
{
GetLocalTime( &st );
snprintf( szRet, 64, "%s, %u %s %u %02u:%02u:%02u %+03d%02d",
days[ st.wDayOfWeek ], st.wDay, months[ st.wMonth -1],
st.wYear,
st.wHour, st.wMinute, st.wSecond,
(int)( tzInfo.Bias / 60 ),
(int)( tzInfo.Bias % 60 > 0 ? - tzInfo.Bias % 60 : tzInfo.Bias % 60 ) );
}
else
{
lDate = hb_itemGetDL( pDate );
hb_dateDecode( lDate, &iYear, &iMonth, &iDay );
snprintf( szRet, 64, "%s, %d %s %d %02u:%02u:%02u %+03d%02d",
days[ hb_dateDOW( iYear, iMonth, iDay ) - 1 ], iDay,
months[ iMonth -1], iYear,
(UINT)( ulHour / 3600 ), (UINT)( (ulHour % 3600) / 60 ), (UINT)( ulHour % 60 ),
(int)( tzInfo.Bias / 60 ),
(int)( tzInfo.Bias % 60 > 0 ? - tzInfo.Bias % 60 : tzInfo.Bias % 60 ) );
}
nLen = strlen( szRet );
if ( nLen < 64 )
{
szRet = (char *) hb_xrealloc( szRet, nLen + 1 );
}
hb_retclen_buffer( szRet, nLen );
}
utils.c 79 HB_FUNC TIP_TIMESTAMP(void)
HB_FUNC( TIP_TIMESTAMP )
{
PHB_ITEM pDate = hb_param( 1, HB_IT_DATE );
ULONG ulHour = hb_parl(2);
int nLen;
char szDate[9];
struct tm tmTime;
time_t current;
char *szRet = (char *) hb_xgrab( 64 );
if ( !ulHour )
{
ulHour = 0;
}
/* init time structure anyway */
time( ¤t );
#if _POSIX_C_SOURCE < 199506L || defined( HB_OS_DARWIN_5 )
memcpy( (void *) &tmTime, (void *) localtime( ¤t ), sizeof(tmTime) );
#else
localtime_r( ¤t , &tmTime );
#endif
if ( pDate )
{
hb_itemGetDS( pDate, szDate );
tmTime.tm_year = (
(szDate[0] - '0') * 1000 +
(szDate[1] - '0') * 100 +
(szDate[2] - '0') * 10 +
(szDate[3] - '0') ) -1900;
tmTime.tm_mon = (
(szDate[4] - '0') * 10 +
(szDate[5] - '0') ) -1;
tmTime.tm_mday =
(szDate[6] - '0') * 10 +
(szDate[7] - '0');
tmTime.tm_hour = ulHour / 3600;
tmTime.tm_min = (ulHour % 3600) / 60;
tmTime.tm_sec = (ulHour % 60);
}
nLen = strftime( szRet, 64, "%a, %d %b %Y %H:%M:%S %z", &tmTime );
if ( nLen < 64 )
{
szRet = (char *) hb_xrealloc( szRet, nLen + 1 );
}
hb_retclen_buffer( szRet, nLen );
}
#endif
/** Detects the mimetype of a given file */
typedef struct tag_mime
{
/* Position in stream from which the match begins */
int pos;
/* String to match */
const char *pattern;
/* Mimetype if complete */
const char *mime_type;
/* following entry to determine a mimetype, relative to current position (or 0) */
int next;
/* alternative entry to determine a mimetype, relative to current position (or 0) */
int alternate;
/* flags for confrontation */
short unsigned int flags;
} MIME_ENTRY;
#define MIME_FLAG_TRIMSPACES 0x0001
#define MIME_FLAG_TRIMTABS 0x0002
#define MIME_FLAG_CASEINSENS 0x0004
#define MIME_FLAG_CONTINUE 0x0008
#define MIME_TABLE_SIZE 68
static MIME_ENTRY s_mimeTable[ MIME_TABLE_SIZE ] =
{
/* Dos/win executable */
/* 0*/ { 0, "MZ", "application/x-dosexec", 0, 0, 0 },
/* ELF file */
/* 1*/ { 0, "\177ELF", NULL, 1, 0, 0 },
/* 2*/ { 4, "\x00", NULL, 3, 1, MIME_FLAG_CONTINUE },
/* 3*/ { 4, "\x01", NULL, 2, 1, MIME_FLAG_CONTINUE },
/* 4*/ { 4, "\x02", NULL, 1, 0, MIME_FLAG_CONTINUE },
/* 5*/ { 5, "\x00", NULL, 2, 1, MIME_FLAG_CONTINUE },
/* 6*/ { 5, "\x01", NULL, 1, 0, MIME_FLAG_CONTINUE },
/* 7*/ { 16, "\x00", "application/x-object", 0, 1, MIME_FLAG_CONTINUE },
/* 8*/ { 16, "\x01", "application/x-object", 0, 1, MIME_FLAG_CONTINUE },
/* 9*/ { 16, "\x02", "application/x-executable", 0, 1, MIME_FLAG_CONTINUE },
/* 10*/ { 16, "\x03", "application/x-sharedlib", 0, 1, MIME_FLAG_CONTINUE },
/* 11*/ { 16, "\x04", "application/x-coredump", 0, 0, MIME_FLAG_CONTINUE },
/* Shell script */
/* 12*/ { 0, "#!/bin/sh", "application/x-shellscript", 0, 0, 0 },
/* 13*/ { 0, "#! /bin/sh", "application/x-shellscript", 0, 0, 0 },
/* 14*/ { 0, "#!/bin/csh", "application/x-shellscript", 0, 0, 0 },
/* 15*/ { 0, "#! /bin/csh", "application/x-shellscript", 0, 0, 0 },
/* 16*/ { 0, "#!/bin/ksh", "application/x-shellscript", 0, 0, 0 },
/* 17*/ { 0, "#! /bin/ksh", "application/x-shellscript", 0, 0, 0 },
/* 18*/ { 0, "#!/bin/tcsh", "application/x-shellscript", 0, 0, 0 },
/* 19*/ { 0, "#! /bin/tcsh", "application/x-shellscript", 0, 0, 0 },
/* 20*/ { 0, "#!/usr/local/bin/tcsh", "application/x-shellscript", 0, 0, 0 },
/* 21*/ { 0, "#! /usr/local/bin/tcsh", "application/x-shellscript", 0, 0, 0 },
/* 22*/ { 0, "#!/bin/bash", "application/x-shellscript", 0, 0, 0},
/* 23*/ { 0, "#! /bin/bash", "application/x-shellscript", 0, 0, 0 },
/* 24*/ { 0, "#!/usr/local/bin/bash", "application/x-shellscript", 0, 0, 0 },
/* 25*/ { 0, "#! /usr/local/bin/bash", "application/x-shellscript", 0, 0, 0 },
/* Java object code*/
/* 26*/ { 0, "\xCA\xFE\xBA\xBE", "application/java", 0, 0, 0 },
/* Perl */
/* 27*/ { 0, "#!/bin/perl", "application/x-perl", 0, 0, 0 },
/* 28*/ { 0, "#! /bin/perl", "application/x-perl", 0, 0, 0 },
/* 29*/ { 0, "eval \"exec /bin/perl", "application/x-perl", 0, 0, 0 },
/* 30*/ { 0, "#!/usr/bin/perl", "application/x-perl", 0, 0, 0 },
/* 31*/ { 0, "#! /usr/bin/perl", "application/x-perl", 0, 0, 0 },
/* 32*/ { 0, "eval \"exec /usr/bin/perl", "application/x-perl", 0, 0, 0 },
/* 33*/ { 0, "#!/usr/local/bin/perl", "application/x-perl", 0, 0, 0 },
/* 34*/ { 0, "#! /usr/local/bin/perl", "application/x-perl", 0, 0, 0 },
/* 35*/ { 0, "eval \"exec /usr/local/bin/perl", "application/x-perl", 0, 0, 0 },
/* Python */
/* 36*/ { 0, "#!/bin/python", "application/x-python", 0, 0, 0 },
/* 37*/ { 0, "#! /bin/python", "application/x-python", 0, 0, 0 },
/* 38*/ { 0, "eval \"exec /bin/python", "application/x-python", 0, 0, 0 },
/* 39*/ { 0, "#!/usr/bin/python", "application/x-python", 0, 0, 0 },
/* 40*/ { 0, "#! /usr/bin/python", "application/x-python", 0, 0, 0 },
/* 41*/ { 0, "eval \"exec /usr/bin/python", "application/x-python", 0, 0, 0 },
/* 42*/ { 0, "#!/usr/local/bin/python", "application/x-python", 0, 0, 0 },
/* 43*/ { 0, "#! /usr/local/bin/python", "application/x-python", 0, 0, 0 },
/* 44*/ { 0, "eval \"exec /usr/local/bin/python", "application/x-python", 0, 0, 0 },
/* Unix compress (.z) */
/* 45*/ { 0, "\x1F\x9D", "application/x-compress", 0, 0, 0 },
/* Unix gzip */
/* 46*/ { 0, "\x1F\x8B", "application/x-gzip", 0, 0, 0 },
/* PKzip */
/* 47*/ { 0, "PK\x03\x04", "application/x-zip", 0, 0, 0 },
/* xml */
/* 48*/ { 0, "utils.c 148 STATIC CONST CHAR s_findExtMimeType( const char *cExt )
static const char *s_findExtMimeType( const char *cExt )
{
int iCount;
for ( iCount = 0; iCount < EXT_MIME_TABLE_SIZE; iCount ++ )
{
if ( s_extMimeTable[iCount].flags == MIME_FLAG_CASEINSENS )
{
if ( hb_stricmp( cExt, s_extMimeTable[iCount].pattern ) == 0)
{
return s_extMimeTable[iCount].mime_type;
}
}
else
{
if ( strcmp( cExt, s_extMimeTable[iCount].pattern ) == 0)
{
return s_extMimeTable[iCount].mime_type;
}
}
}
return NULL;
}
utils.c 393 STATIC CONST CHAR s_findMimeStringInTree( const char *cData, int iLen, int iElem )
static const char *s_findMimeStringInTree( const char *cData, int iLen, int iElem )
{
MIME_ENTRY *elem = s_mimeTable + iElem;
int iPos = elem->pos;
int iDataLen = strlen( elem->pattern );
/* allow \0 to be used for matches */
if ( iDataLen == 0 )
{
iDataLen = 1;
}
/* trim spaces if required */
while ( iPos < iLen &&
( (( elem->flags & MIME_FLAG_TRIMSPACES ) == MIME_FLAG_TRIMSPACES && (
cData[iPos] == ' ' || cData[iPos] == '\r' || cData[iPos] == '\n') ) ||
(( elem->flags & MIME_FLAG_TRIMTABS ) == MIME_FLAG_TRIMSPACES && cData[iPos] == '\t') ) )
{
iPos ++;
}
if ( (iPos < iLen) && (iLen - iPos >= iDataLen) )
{
if ( (elem->flags & MIME_FLAG_CASEINSENS) == MIME_FLAG_CASEINSENS )
{
if ( (*elem->pattern == 0 && cData[iPos] == 0) || hb_strnicmp( cData + iPos, elem->pattern, iDataLen ) == 0)
{
/* is this the begin of a match tree? */
if ( elem->next != 0 )
{
return s_findMimeStringInTree( cData, iLen, iElem + elem->next );
}
else
{
return elem->mime_type;
}
}
}
else
{
if ( (*elem->pattern == 0 && cData[iPos] == 0) || strncmp( cData + iPos, elem->pattern, iDataLen ) == 0)
{
if ( elem->next != 0 )
{
return s_findMimeStringInTree( cData, iLen, iElem + elem->next );
}
else
{
return elem->mime_type;
}
}
}
}
/* match failed! */
if ( elem->alternate != 0 )
{
return s_findMimeStringInTree( cData, iLen, iElem + elem->alternate );
}
/* total giveup */
return NULL;
}
utils.c 420 STATIC CONST CHAR s_findStringMimeType( const char *cData, int iLen )
static const char *s_findStringMimeType( const char *cData, int iLen )
{
int iCount;
BOOL bFormFeed;
for ( iCount = 0; iCount < MIME_TABLE_SIZE; iCount ++ )
{
MIME_ENTRY *elem = s_mimeTable + iCount;
int iPos = elem->pos;
int iDataLen = strlen( elem->pattern );
if ( (elem->flags & MIME_FLAG_CONTINUE) == MIME_FLAG_CONTINUE )
{
continue;
}
/* trim spaces if required */
while ( iPos < iLen &&
( (( elem->flags & MIME_FLAG_TRIMSPACES ) == MIME_FLAG_TRIMSPACES && (
cData[iPos] == ' ' || cData[iPos] == '\r' || cData[iPos] == '\n') ) ||
(( elem->flags & MIME_FLAG_TRIMTABS ) == MIME_FLAG_TRIMSPACES && cData[iPos] == '\t') ) )
{
iPos ++;
}
if ( iPos >= iLen )
{
continue;
}
if ( iLen - iPos < iDataLen )
{
continue;
}
if ( (elem->flags & MIME_FLAG_CASEINSENS) == MIME_FLAG_CASEINSENS )
{
if ( (*elem->pattern == 0 && cData[iPos] == 0) || hb_strnicmp( cData + iPos, elem->pattern, iDataLen ) == 0)
{
/* is this the begin of a match tree? */
if ( elem->next != 0 )
{
return s_findMimeStringInTree( cData, iLen, iCount + elem->next );
}
else
{
return elem->mime_type;
}
}
}
else
{
if ( (*elem->pattern == 0 && cData[iPos] == 0) || strncmp( cData + iPos, elem->pattern, iDataLen ) == 0)
{
if ( elem->next != 0 )
{
return s_findMimeStringInTree( cData, iLen, iCount + elem->next );
}
else
{
return elem->mime_type;
}
}
}
}
/* Failure; let's see if it's a text/plain. */
bFormFeed = FALSE;
iCount = 0;
while ( iCount < iLen )
{
/* form feed? */
if ( cData[ iCount ] == '\x0C' )
{
bFormFeed = TRUE;
}
/* esc sequence? */
else if ( cData[iCount] == '\x1B' )
{
bFormFeed = TRUE;
iCount ++;
if ( cData[iCount] <= 27 )
{
iCount ++;
}
if ( cData[iCount] <= 27 )
{
iCount ++;
}
}
else if (
(cData[iCount] < 27 && cData[iCount] != '\t' && cData[iCount] != '\n' && cData[iCount] == '\r') ||
cData[iCount] == '\xFF')
{
/* not an ASCII file, we surrender */
return NULL;
}
iCount++;
}
if ( bFormFeed )
{
/* we have escape sequences, seems a PRN/terminal file */
return "application/remote-printing";
}
return "text/plain";
}
utils.c 485 STATIC CONST CHAR s_findFileMimeType( HB_FHANDLE fileIn )
static const char *s_findFileMimeType( HB_FHANDLE fileIn )
{
char buf[512];
int iLen;
ULONG ulPos;
ulPos = hb_fsSeek( fileIn, 0, SEEK_CUR );
hb_fsSeek( fileIn, 0, SEEK_SET );
iLen = hb_fsRead( fileIn, ( BYTE * ) buf, 512 );
if ( iLen > 0 )
{
hb_fsSeek( fileIn, ulPos, SEEK_SET );
return s_findStringMimeType( buf, iLen );
}
return NULL;
}
utils.c 596 HB_FUNC TIP_FILEMIMETYPE(void)
HB_FUNC( TIP_FILEMIMETYPE )
{
PHB_ITEM pFile = hb_param( 1, HB_IT_STRING | HB_IT_NUMERIC );
const char *ext_type = NULL;
const char *magic_type = NULL;
HB_FHANDLE fileIn;
if ( pFile == NULL )
{
hb_errRT_BASE_SubstR( EG_ARG, 0, NULL, HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
if ( HB_IS_STRING( pFile ) )
{
/* decode the extension */
char *fname = hb_itemGetCPtr( pFile );
int iPos = strlen( fname )-1;
while ( iPos >= 0 && fname[iPos] != '.' )
{
iPos--;
}
if ( iPos > 0 )
{
ext_type = s_findExtMimeType( fname + iPos + 1 );
}
fileIn = hb_fsOpen( ( BYTE * ) fname, FO_READ );
if ( hb_fsError() == 0 )
{
magic_type = s_findFileMimeType( fileIn );
}
hb_fsClose( fileIn );
}
else
{
fileIn = ( HB_FHANDLE ) hb_itemGetNL( pFile );
magic_type = s_findFileMimeType( fileIn );
}
if ( magic_type == NULL )
{
if ( ext_type != NULL )
{
hb_retc( ext_type );
}
else
{
hb_retc( "unknown" ); /* it's a valid MIME type */
}
}
else
{
hb_retc( magic_type );
}
}
utils.c 617 HB_FUNC TIP_MIMETYPE(void)
HB_FUNC( TIP_MIMETYPE )
{
PHB_ITEM pData = hb_param( 1, HB_IT_STRING );
const char *magic_type;
const char *cData;
ULONG ulLen;
if ( pData == NULL )
{
hb_errRT_BASE_SubstR( EG_ARG, 0, NULL, HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
return;
}
ulLen = hb_itemGetCLen( pData );
cData = hb_itemGetCPtr( pData );
magic_type = s_findStringMimeType( cData, ulLen );
if ( magic_type == NULL )
{
hb_retc( "unknown" );
}
else
{
hb_retc( magic_type );
}
}
utils.c 678 HB_FUNC PSTRCOMPI(void)
HB_FUNC( PSTRCOMPI )
{
PHB_ITEM pString = hb_param( 1, HB_IT_STRING );
PHB_ITEM pStart = hb_param( 2, HB_IT_NUMERIC );
PHB_ITEM pSubstr = hb_param( 3, HB_IT_STRING );
if( pString && pStart && pSubstr )
{
char * pcBase = hb_itemGetCPtr( pString ) ;
char * pcSub = hb_itemGetCPtr( pSubstr ) ;
ULONG uSublen = hb_itemGetCLen( pSubstr ) ;
ULONG uStart = hb_itemGetNL( pStart ) ;
hb_retl( hb_strnicmp( pcBase + uStart - 1, pcSub, uSublen ) == 0 );
}
else
hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
utils.c 714 STATIC ULONG HB_EXPORT hb_strAtI( const char * szSub, ULONG ulSubLen, const char * szText, ULONG ulLen )
static ULONG HB_EXPORT hb_strAtI( const char * szSub, ULONG ulSubLen, const char * szText, ULONG ulLen )
{
HB_TRACE(HB_TR_DEBUG, ("hb_strAtI(%s, %lu, %s, %lu)", szSub, ulSubLen, szText, ulLen));
if( ulSubLen > 0 && ulLen >= ulSubLen )
{
ULONG ulPos = 0;
ULONG ulSubPos = 0;
while( ulPos < ulLen && ulSubPos < ulSubLen )
{
if( tolower( (BYTE) szText[ ulPos ] ) == tolower( (BYTE) szSub[ ulSubPos ] ) )
{
ulSubPos++;
ulPos++;
}
else if( ulSubPos )
{
/* Go back to the first character after the first match,
or else tests like "22345" $ "012223456789" will fail. */
ulPos -= ( ulSubPos - 1 );
ulSubPos = 0;
}
else
ulPos++;
}
return ( ulSubPos < ulSubLen ) ? 0 : ( ulPos - ulSubLen + 1 );
}
else
return 0;
}
utils.c 733 HB_FUNC ATI(void)
HB_FUNC( ATI )
{
PHB_ITEM pSub = hb_param( 1, HB_IT_STRING );
PHB_ITEM pText = hb_param( 2, HB_IT_STRING );
PHB_ITEM pStart = hb_param( 3, HB_IT_NUMERIC );
PHB_ITEM pEnd = hb_param( 4, HB_IT_NUMERIC );
if( pText && pSub )
{
LONG lLen = hb_itemGetCLen( pText );
LONG lStart = pStart ? hb_itemGetNL( pStart ) : 1;
LONG lEnd = pEnd ? hb_itemGetNL( pEnd ) : lLen;
ULONG ulPos;
if( lStart < 0 )
{
lStart += lLen;
if( lStart < 0 )
lStart = 0;
}
else if( lStart )
lStart--;
if( lEnd < 0 )
lEnd += lLen + 1;
if( lEnd > lLen )
lEnd = lLen;
/* Stop searching if starting past beyond end. */
if( lStart >= lEnd )
hb_retnl( 0 );
else
{
ulPos = hb_strAtI( hb_itemGetCPtr( pSub ), hb_itemGetCLen( pSub ),
hb_itemGetCPtr( pText ) + lStart, lEnd - lStart );
hb_retnl( ulPos ? ulPos + lStart : 0 );
}
}
else
{
hb_errRT_BASE_SubstR( EG_ARG, 1108, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
}
utils.c 766 HB_FUNC HB_EXEC(void)
HB_FUNC( HB_EXEC )
{
if( ISSYMBOL( 1 ) )
{
BOOL fSend = FALSE;
int iParams = hb_pcount() - 1;
if( iParams >= 1 )
{
fSend = iParams > 1 && ! HB_IS_NIL( hb_param( 2, HB_IT_ANY ) );
iParams--;
}
else
hb_vmPushNil();
if( fSend )
hb_vmSend( ( USHORT ) iParams );
else
hb_vmDo( ( USHORT ) iParams );
}
else
hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
utils.c 811 HB_FUNC TIP_HTMLSPECIALCHARS(void)
HB_FUNC( TIP_HTMLSPECIALCHARS )
{
const char *cData = hb_parc(1);
int nLen = hb_parclen(1);
char *cRet;
int nPos = 0, nPosRet = 0;
BYTE cElem;
if ( ! cData )
{
hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, 1, hb_paramError(1) );
return;
}
if ( ! nLen )
{
hb_retc( NULL );
return;
}
/* Giving maximum final length possible */
cRet = (char *) hb_xgrab( nLen * 6 +1);
while ( nPos < nLen )
{
cElem = ( BYTE )cData[ nPos ];
if ( cElem == '&' )
{
cRet[ nPosRet++ ] = '&';
cRet[ nPosRet++ ] = 'a';
cRet[ nPosRet++ ] = 'm';
cRet[ nPosRet++ ] = 'p';
cRet[ nPosRet++ ] = ';';
}
else if ( cElem == '<' )
{
cRet[ nPosRet++ ] = '&';
cRet[ nPosRet++ ] = 'l';
cRet[ nPosRet++ ] = 't';
cRet[ nPosRet++ ] = ';';
}
else if ( cElem == '>' )
{
cRet[ nPosRet++ ] = '&';
cRet[ nPosRet++ ] = 'g';
cRet[ nPosRet++ ] = 't';
cRet[ nPosRet++ ] = ';';
}
else if ( cElem == '"' )
{
cRet[ nPosRet++ ] = '&';
cRet[ nPosRet++ ] = 'q';
cRet[ nPosRet++ ] = 'u';
cRet[ nPosRet++ ] = 'o';
cRet[ nPosRet++ ] = 't';
cRet[ nPosRet++ ] = ';';
}
else if ( cElem == '\'' )
{
cRet[ nPosRet++ ] = '&';
cRet[ nPosRet++ ] = '#';
cRet[ nPosRet++ ] = '0';
cRet[ nPosRet++ ] = '3';
cRet[ nPosRet++ ] = '9';
cRet[ nPosRet++ ] = ';';
}
else if ( cElem == '\r' )
{
cRet[ nPosRet++ ] = '&';
cRet[ nPosRet++ ] = '#';
cRet[ nPosRet++ ] = '0';
cRet[ nPosRet++ ] = '1';
cRet[ nPosRet++ ] = '3';
cRet[ nPosRet++ ] = ';';
}
else if ( cElem == '\n' )
{
cRet[ nPosRet++ ] = '&';
cRet[ nPosRet++ ] = '#';
cRet[ nPosRet++ ] = '0';
cRet[ nPosRet++ ] = '1';
cRet[ nPosRet++ ] = '0';
cRet[ nPosRet++ ] = ';';
}
else if ( cElem >= ' ' )
{
cRet[ nPosRet ] = cElem;
nPosRet++;
}
nPos++;
}
hb_retclen_buffer( cRet, nPosRet );
}
utils.c 834 cgi.prg Type Function Source Line CLASS TIpCgi
CLASS TIpCgi
DATA 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
METHOD New()
METHOD Header( hOptions )
METHOD Redirect( cUrl )
METHOD Print( cString )
METHOD Flush()
METHOD ErrHandler()
METHOD StartHtml( hOptions )
METHOD EndHtml()
METHOD StartFrameSet( hOptions )
METHOD EndFrameSet()
METHOD SaveHtmlPage( cFile )
METHOD StartSession()
METHOD DestroySession()
cgi.prg 74 TIPCGI:METHOD CreateSID( cCRCKey )
METHOD CreateSID( cCRCKey ) INLINE ::cSID := TIP_GenerateSID( cCrcKey )
cgi.prg 105 TIPCGI:METHOD CheckCrcSID( cSID, cCRCKey )
METHOD CheckCrcSID( cSID, cCRCKey ) INLINE TIP_CheckSID( cSID, cCRCKey )
METHOD SessionEncode()
METHOD SessionDecode( cData )
ENDCLASS
cgi.prg 106 TIPCGI:METHOD New() CLASS TIpCgi
METHOD New() CLASS TIpCgi
local aTemp := {}
local aVar := {}
local lPost
local nCount
local nLen
local nRead
local cTemp
::bSavedErrHandler := ErrorBlock( { |e| ::ErrHandler( e ) } )
::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
::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( 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
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
RETURN Self
cgi.prg 112 TIPCGI:METHOD Header( cValue ) CLASS TIpCgi
METHOD Header( cValue ) CLASS TIpCgi
if empty( cValue )
::cCgiHeader += "Content-Type: text/html" + _CRLF
else
::cCgiHeader += cValue + _CRLF
endif
RETURN Self
cgi.prg 178 TIPCGI:METHOD Redirect( cUrl ) CLASS TIpCgi
METHOD Redirect( cUrl ) CLASS TIpCgi
::cCgiHeader += "Location: " + cUrl + _CRLF
RETURN Self
cgi.prg 188 TIPCGI:METHOD Print( cString ) CLASS TIpCgi
METHOD Print( cString ) CLASS TIpCgi
::cHtmlPage += cString + _CRLF
RETURN Self
cgi.prg 194 TIPCGI:METHOD Flush() CLASS TIpCgi
METHOD Flush() CLASS TIpCgi
local nLen
local cStream
local lRet
local nH
local cFile
local nFileSize
local cSID := ::cSID
local cSession
hb_hEval( ::hCookies, { |k,v| ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } )
cStream := ::cCgiHeader + _CRLF + ::cHtmlPage + _CRLF
nLen := len( cStream )
lRet := ( Fwrite( CGI_OUT, cStream, nLen ) == nLen )
if ::lDumpHtml
if empty( ::cDumpSavePath )
::cDumpSavePath := "/tmp/"
endif
if ( nH := FCreate( ::cDumpSavePath + "dump.html", FC_NORMAL ) ) != -1
Fwrite( nH, ::cHtmlPage, len( ::cHtmlPage ) )
endif
fclose( nH )
endif
::cCgiHeader := ""
::cHtmlPage := ""
if !empty( cSID )
cFile := ::cSessionSavePath + "SESSIONID_" + cSID
cSession := ::SessionEncode()
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
RETURN lRet
cgi.prg 200 TIPCGI:METHOD DestroySession( cID ) CLASS TIpCgi
METHOD DestroySession( cID ) CLASS TIpCgi
local cFile
local cSID := ::cSID
local lRet
if !empty( cID )
cSID := cID
endif
if !empty( cSID )
::hSession := {=>}
cFile := ::cSessionSavePath + "SESSIONID_" + cSID
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
endif
RETURN lRet
cgi.prg 255 TIPCGI:METHOD ErrHandler( xError ) CLASS TIpCgi
METHOD ErrHandler( xError ) CLASS TIpCgi
local nCalls
::Print( ' ' )
::Print( '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 ) ) + ' FILENAME: ' + right( xError:FileName, 40 ) + ' ERROR MESSAGE: ' + xError + ' PROC/LINE: ' + procname( nCalls ) + "/" + alltrim( str( procline( nCalls ) ) ) + '
' )
::Flush()
RETURN nil
cgi.prg 284 TIPCGI:METHOD StartHtml( hOptions ) CLASS TIpCgi
METHOD StartHtml( hOptions ) CLASS TIpCgi
::cHtmlPage += '' + _CRLF + ;
'' + _CRLF + ;
'' + ;
'' + ;
HtmlTag( hOptions, 'title', 'title' ) + ;
HtmlScript( hOptions ) + ;
HtmlStyle( hOptions ) + ;
'' + ;
''
RETURN Self
cgi.prg 313 TIPCGI:METHOD EndHtml() CLASS TIpCgi
METHOD EndHtml() CLASS TIpCgi
::cHtmlPage += ''
RETURN Self
cgi.prg 330 TIPCGI:METHOD StartFrameSet( hOptions ) CLASS TIpCgi
METHOD StartFrameSet( hOptions ) CLASS TIpCgi
::cHtmlPage += '' + _CRLF + ;
'' + _CRLF + ;
'' + ;
'' + ;
HtmlTag( hOptions, 'title', 'title' ) + ;
HtmlScript( hOptions ) + ;
HtmlStyle( hOptions ) + ;
'' + ;
''
RETURN Self
cgi.prg 336 TIPCGI:METHOD EndFrameSet( hOptions ) CLASS TIpCgi
METHOD EndFrameSet( hOptions ) CLASS TIpCgi
::cHtmlPage += '<![CDATA[' + ;
HtmlValue( hOptions, 'frame' ) + ;
']]> '
RETURN Self
cgi.prg 353 TIPCGI:METHOD SaveHtmlPage( cFile ) CLASS TIpCgi
METHOD SaveHtmlPage( cFile ) CLASS TIpCgi
local nFile
local lSuccess
local nLen
local cStream
cStream := ::cHtmlPage + _CRLF
nLen := len( cStream )
nFile := fcreate( cFile )
if nFile != 0
lSuccess := ( fwrite( nFile, cStream, nLen ) == nLen )
fclose( nFile )
else
lSuccess := .f.
endif
RETURN lSuccess
cgi.prg 361 TIPCGI:METHOD StartSession( cSID ) CLASS TIpCgi
METHOD StartSession( cSID ) CLASS TIpCgi
local nH
local cFile
local nFileSize
local cBuffer
if empty( cSID )
if ( nH := hb_HPos( ::hGets, "SESSIONID" ) ) != 0
cSID := hb_HValueAt( ::hGets, nH )
elseif ( nH := hb_HPos( ::hPosts, "SESSIONID" ) ) != 0
cSID := hb_HValueAt( ::hPosts, nH )
elseif ( nH := hb_HPos( ::hCookies, "SESSIONID" ) ) != 0
cSID := hb_HValueAt( ::hCookies, nH )
endif
endif
if empty( ::cSessionSavePath )
::cSessionSavePath := "/tmp/"
endif
if !empty( cSID )
::cSID := cSID
cFile := ::cSessionSavePath + "SESSIONID_" + cSID
if file( cFile )
if ( nH := FOpen( cFile, FO_READ ) ) != -1
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() ) )
else
::SessionDecode( cBuffer )
endif
fclose( nH )
endif
else
::ErrHandler( "ERROR: On opening session file : " + cFile + ", file not exist." )
endif
else
::CreateSID()
::hSession := {=>}
endif
::hCookies[ "SESSIONID" ] := ::cSID
RETURN Self
cgi.prg 383 TIPCGI:METHOD SessionEncode() CLASS TIpCgi
METHOD SessionEncode() CLASS TIpCgi
RETURN HB_Serialize( ::hSession )
cgi.prg 439 TIPCGI:METHOD SessionDecode( cData ) CLASS TIpCgi
METHOD SessionDecode( cData ) CLASS TIpCgi
::hSession := HB_Deserialize( cData )
RETURN Valtype( ::hSession ) == "H"
cgi.prg 443 STATIC FUNCTION HtmlTag( xVal, cKey, cDefault )
STATIC FUNCTION HtmlTag( xVal, cKey, cDefault )
local cVal := ""
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 cVal == ""
cVal := cDefault
endif
if !( cVal == "" )
cVal := "<" + cKey + ">" + cVal + ""
endif
return cVal
cgi.prg 449 STATIC FUNCTION HtmlAllTag( hTags, cSep )
STATIC FUNCTION HtmlAllTag( hTags, cSep )
local cVal := ""
DEFAULT cSep TO " "
hb_hEval( hTags, { |k| cVal += HtmlTag( hTags, k ) + cSep } )
return cVal
cgi.prg 472 STATIC FUNCTION HtmlOption( xVal, cKey, cPre, cPost, lScan )
STATIC FUNCTION HtmlOption( xVal, cKey, cPre, cPost, lScan )
local cVal := ""
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
cVal := cKey + '="' + cVal + '"'
if cPre != nil
cVal := cPre + cVal
endif
if cPost != nil
cVal := cVal + cPost
endif
endif
endif
return cVal
cgi.prg 482 STATIC FUNCTION HtmlAllOption( hOptions, cSep )
STATIC FUNCTION HtmlAllOption( hOptions, cSep )
local cVal := ""
DEFAULT cSep TO " "
if !empty( hOptions )
hb_hEval( hOptions, { |k| cVal += HtmlOption( hOptions, k,,, .t. ) + cSep } )
endif
return cVal
cgi.prg 506 STATIC FUNCTION HtmlValue( xVal, cKey, cDefault )
STATIC FUNCTION HtmlValue( xVal, cKey, cDefault )
local cVal := ""
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 cVal == ""
cVal := cDefault
endif
return cVal
cgi.prg 518 STATIC FUNCTION HtmlAllValue( hValues, cSep )
STATIC FUNCTION HtmlAllValue( hValues, cSep )
local cVal := ""
DEFAULT cSep TO " "
if !empty( hValues )
hb_hEval( hValues, { |k| cVal += HtmlValue( hValues, k ) + cSep } )
endif
return cVal
cgi.prg 537 STATIC FUNCTION HtmlScript( xVal, cKey )
STATIC FUNCTION HtmlScript( xVal, cKey )
local cVal := ""
local nPos
local cTmp
DEFAULT cKey TO "script"
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
cVal := hb_HValueAt( cVal, nPos )
if valtype( cVal ) == "C"
cVal := { cVal }
endif
if valtype( cVal ) == "A"
cTmp := ""
ascan( cVal, { |cFile| cTmp += '' + _CRLF
endif
endif
endif
hb_hDel( xVal, cKey )
endif
endif
return cVal
cgi.prg 549 STATIC FUNCTION HtmlStyle( xVal, cKey )
STATIC FUNCTION HtmlStyle( xVal, cKey )
local cVal := ""
local nPos
local cTmp
DEFAULT cKey TO "style"
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
cVal := hb_HValueAt( cVal, nPos )
if valtype( cVal ) == "C"
cVal := { cVal }
endif
if valtype( cVal ) == "A"
cTmp := ""
ascan( cVal, { |cFile| cTmp += ' cgi.prg 590 client.prg Type Function Source Line CLASS tIPClient
CLASS tIPClient
CLASSDATA bInitSocks INIT .F.
CLASSDATA cCRLF INIT HB_InetCRLF()
DATA oUrl // url to wich to connect
DATA oCredentials // credential needed to access the service
DATA nStatus // basic status
DATA SocketCon
Data lTrace
Data nHandle
DATA nDefaultRcvBuffSize
DATA nDefaultSndBuffSize
/* Input stream length */
DATA nLength
/* Input stream data read by the app*/
DATA nRead
/* Last physical read amount */
DATA nLastRead
DATA nDefaultPort
DATA nConnTimeout
DATA bInitialized
DATA cReply
DATA nAccessMode
DATA nWrite
DATA nLastWrite
DATA bEof
DATA isOpen INIT .F.
/** Gauge control; it can be a codeblock or a function pointer. */
DATA exGauge
DATA Cargo
METHOD New( oUrl, lTrace, oCredentials )
METHOD Open()
METHOD Read( iLen )
METHOD ReadToFile( cFile, nMode, nSize )
METHOD Write( cData, iLen, bCommit )
METHOD Commit()
METHOD WriteFromFile( cFile )
METHOD Reset()
METHOD Close()
/* METHOD Data( cData ) */ // commented: calls undeclared METHOD :getOk
client.prg 86 TIPCLIENT:METHOD lastErrorCode()
METHOD lastErrorCode() INLINE ::nLastError
client.prg 136 TIPCLIENT:METHOD lastErrorMessage(SocketCon)
METHOD lastErrorMessage(SocketCon) INLINE ::INetErrorDesc(SocketCon)
METHOD InetRcvBufSize( SocketCon, nSizeBuff )
METHOD InetSndBufSize( SocketCon, nSizeBuff )
PROTECTED:
DATA nLastError INIT 0
/* Methods to log data if needed */
METHOD InetRecv( SocketCon, cStr1, len)
METHOD InetRecvLine( SocketCon, nLen, size )
METHOD InetRecvAll( SocketCon, cStr1, len )
METHOD InetCount( SocketCon )
METHOD InetSendAll( SocketCon, cData, nLen )
METHOD InetErrorCode(SocketCon)
METHOD InetErrorDesc(SocketCon)
METHOD InetConnect( cServer, nPort, SocketCon )
METHOD Log()
ENDCLASS
client.prg 137 TIPCLIENT:METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClient
METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClient
LOCAL oErr
Default lTrace to .F.
IF .not. ::bInitSocks
HB_InetInit()
::bInitSocks := .T.
ENDIF
IF HB_IsString( oUrl )
oUrl := tUrl():New( oUrl )
ENDIF
IF .NOT. oURL:cProto $ "ftp,http,pop,smtp"
oErr := ErrorNew()
oErr:Args := { Self, oURL:cProto }
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
oErr:Description := "unsupported protocol"
oErr:GenCode := EG_UNSUPPORTED
oErr:Operation := ::className()+":new()"
oErr:Severity := ES_ERROR
oErr:SubCode := 1081
oErr:SubSystem := "BASE"
Eval( ErrorBlock(), oErr )
ENDIF
::oUrl := oUrl
::oCredentials := oCredentials
::nStatus := 0
::bInitialized := .F.
::nWrite := 0
::nLastWrite := 0
::nLength := -1
::nRead := 0
::nLastRead := 0
::bEof := .F.
::lTrace := lTrace
RETURN self
client.prg 160 TIPCLIENT:METHOD Open( cUrl ) CLASS tIPClient
METHOD Open( cUrl ) CLASS tIPClient
LOCAL nPort
IF HB_IsString( cUrl )
::oUrl := tUrl():New( cUrl )
ENDIF
IF ::oUrl:nPort == -1
nPort := ::nDefaultPort
ELSE
nPort := ::oUrl:nPort
ENDIF
::SocketCon := HB_InetCreate()
HB_InetTimeout( ::SocketCon, ::nConnTimeout )
::InetConnect( ::oUrl:cServer, nPort, ::SocketCon )
IF ::InetErrorCode( ::SocketCon ) != 0
RETURN .F.
ENDIF
::isOpen := .T.
RETURN .T.
client.prg 205 TIPCLIENT:METHOD Close() CLASS tIPClient
METHOD Close() CLASS tIPClient
local nRet:=-1
IF .not. Empty( ::SocketCon )
nRet := HB_InetClose( ::SocketCon )
::SocketCon:=nil
::isOpen := .F.
ENDIF
RETURN(nRet)
client.prg 233 TIPCLIENT:METHOD Reset() CLASS tIPClient
METHOD Reset() CLASS tIPClient
::bInitialized := .F.
::bEof := .F.
RETURN .T.
client.prg 249 TIPCLIENT:METHOD Commit() CLASS tIPClient
METHOD Commit() CLASS tIPClient
RETURN .T.
client.prg 256 TIPCLIENT:METHOD Read( nLen ) CLASS tIPClient
METHOD Read( nLen ) CLASS tIPClient
LOCAL cStr0, cStr1
IF ::nLength > 0 .and. ::nLength == ::nRead
RETURN NIL
ENDIF
IF Empty( nLen ) .or. nLen < 0 .or.( ::nLength > 0 .and. nLen > ::nLength - ::nRead )
nLen := ::nLength - ::nRead
ENDIF
IF Empty( nLen ) .or. nLen < 0
// read till end of stream
cStr1 := Space( RCV_BUF_SIZE )
cStr0 := ""
::nLastRead := ::InetRecv( ::SocketCon, @cStr1, RCV_BUF_SIZE )
DO WHILE ::nLastRead > 0
::nRead += ::nLastRead
cStr0 += Substr( cStr1, 1, ::nLastRead )
::nLastRead := ::InetRecv( ::SocketCon, @cStr1, RCV_BUF_SIZE )
ENDDO
::bEof := .T.
ELSE
// read an amount of data
cStr0 := Space( nLen )
// S.R. if len of file is less than RCV_BUF_SIZE HB_InetRecvAll return 0
// ::nLastRead := HB_InetRecvAll( ::SocketCon, @cStr0, nLen )
::InetRecvAll( ::SocketCon, @cStr0, nLen )
::nLastRead := ::InetCount( ::SocketCon )
::nRead += ::nLastRead
IF ::nLastRead != nLen
::bEof := .T.
cStr0 := Substr( cStr0, 1, ::nLastRead )
// S.R. RETURN NIL
ENDIF
IF ::nRead == ::nLength
::bEof := .T.
ENDIF
ENDIF
RETURN cStr0
client.prg 261 TIPCLIENT:METHOD ReadToFile( cFile, nMode, nSize ) CLASS tIPClient
METHOD ReadToFile( cFile, nMode, nSize ) CLASS tIPClient
LOCAL nFout
LOCAL cData
LOCAL nSent
IF Empty ( nMode )
nMode := FC_NORMAL
ENDIF
nSent := 0
IF !Empty( ::exGauge )
HB_ExecFromArray( ::exGauge, { nSent, nSize, Self } )
ENDIF
::nRead := 0
::nStatus := 1
DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .and. .not. ::bEof
cData := ::Read( RCV_BUF_SIZE )
IF cData == NIL
IF nFout != NIL
Fclose( nFout )
ENDIF
IF ::InetErrorCode( ::SocketCon ) > 0
RETURN .F.
ELSE
RETURN .T.
ENDIF
ENDIF
IF nFout == NIL
nFout := Fcreate( cFile, nMode )
IF nFout < 0
::nStatus := 0
RETURN .F.
ENDIF
ENDIF
IF Fwrite( nFout, cData ) < 0
Fclose( nFout )
RETURN .F.
ENDIF
nSent += Len( cData )
IF !Empty( ::exGauge )
HB_ExecFromArray( ::exGauge, { nSent, nSize, Self } )
ENDIF
ENDDO
IF nSent > 0
::Commit()
Endif
::nStatus := 2
Fclose( nFout )
RETURN .T.
client.prg 309 TIPCLIENT:METHOD WriteFromFile( cFile ) CLASS tIPClient
METHOD WriteFromFile( cFile ) CLASS tIPClient
LOCAL nFin
LOCAL cData
LOCAL nLen
LOCAL nSize, nSent, nBufSize
::nWrite := 0
::nStatus := 0
nFin := Fopen( cFile, FO_READ )
IF nFin < 0
RETURN .F.
ENDIF
nSize := FSeek( nFin, 0, 2 )
FSeek( nFin, 0 )
nBufSize := SND_BUF_SIZE
// allow initialization of the gauge
nSent := 0
IF ! Empty( ::exGauge )
HB_ExecFromArray( ::exGauge, {nSent, nSize, Self} )
ENDIF
::nStatus := 1
cData := Space( nBufSize )
nLen := Fread( nFin, @cData, nBufSize )
DO WHILE nLen > 0
IF ::Write( @cData, nLen ) != nLen
Fclose( nFin )
RETURN .F.
ENDIF
nSent += nLen
IF ! Empty( ::exGauge )
HB_ExecFromArray( ::exGauge, {nSent, nSize, Self} )
ENDIF
nLen := Fread( nFin, @cData, nBufSize )
ENDDO
// it may happen that the file has lenght 0
IF nSent > 0
::Commit()
ENDIF
::nStatus := 2
Fclose( nFin )
RETURN .T.
client.prg 369 TIPCLIENT:METHOD Write( cData, nLen, bCommit ) CLASS tIPClient
METHOD Write( cData, nLen, bCommit ) CLASS tIPClient
IF Empty( nLen )
nLen := Len( cData )
ENDIF
::nLastWrite := ::InetSendall( ::SocketCon, cData , nLen )
IF .not. Empty( bCommit ) .and. bCommit
::Commit()
ENDIF
::nWrite += ::nLastWrite
RETURN ::nLastWrite
client.prg 430 TIPCLIENT:METHOD InetSendAll( SocketCon, cData, nLen ) CLASS tIPClient
METHOD InetSendAll( SocketCon, cData, nLen ) CLASS tIPClient
Local nRet
IF Empty( nLen )
nLen := Len( cData )
ENDIF
nRet := HB_InetSendAll( SocketCon, cData, nLen )
if ::lTrace
::Log( SocketCon, nlen, cData, nRet )
endif
Return nRet
client.prg 450 TIPCLIENT:METHOD InetCount( SocketCon ) CLASS tIPClient
METHOD InetCount( SocketCon ) CLASS tIPClient
Local nRet
nRet := HB_InetCount( SocketCon )
if ::lTrace
::Log( SocketCon, nRet )
endif
Return nRet
client.prg 468 TIPCLIENT:METHOD InetRecv( SocketCon, cStr1, len ) CLASS tIPClient
METHOD InetRecv( SocketCon, cStr1, len ) CLASS tIPClient
Local nRet
nRet := HB_InetRecv( SocketCon, @cStr1, len )
if ::lTrace
::Log( SocketCon, "", len, iif( nRet >= 0, cStr1, nRet ) )
endif
Return nRet
client.prg 482 TIPCLIENT:METHOD InetRecvLine( SocketCon, nLen, size ) CLASS tIPClient
METHOD InetRecvLine( SocketCon, nLen, size ) CLASS tIPClient
Local cRet
cRet := HB_InetRecvLine( SocketCon, @nLen, size )
if ::lTrace
::Log( SocketCon, "", size, cRet )
endif
Return cRet
client.prg 498 TIPCLIENT:METHOD InetRecvAll( SocketCon, cStr1, len ) CLASS tIPClient
METHOD InetRecvAll( SocketCon, cStr1, len ) CLASS tIPClient
Local nRet
nRet := HB_InetRecvAll( SocketCon, @cStr1, len )
if ::lTrace
::Log( SocketCon, "", len, iif( nRet >= 0, cStr1, nRet ) )
endif
Return nRet
client.prg 514 TIPCLIENT:METHOD InetErrorCode( SocketCon ) CLASS tIPClient
METHOD InetErrorCode( SocketCon ) CLASS tIPClient
Local nRet
::nLastError := nRet := HB_InetErrorCode( SocketCon )
if ::lTrace
::Log( SocketCon, nRet )
endif
Return nRet
client.prg 530 TIPCLIENT:METHOD InetErrorDesc( SocketCon ) CLASS tIPClient
METHOD InetErrorDesc( SocketCon ) CLASS tIPClient
LOCAL cMsg := ""
DEFAULT SocketCon TO ::SocketCon
IF .not. Empty( SocketCon )
cMsg := HB_InetErrorDesc( SocketCon )
ENDIF
RETURN cMsg
client.prg 545 TIPCLIENT:METHOD InetConnect( cServer, nPort, SocketCon ) CLASS tIPClient
METHOD InetConnect( cServer, nPort, SocketCon ) CLASS tIPClient
HB_InetConnect( cServer, nPort, SocketCon )
IF ! Empty( ::nDefaultSndBuffSize )
::InetSndBufSize( SocketCon, ::nDefaultSndBuffSize )
ENDIF
IF ! Empty( ::nDefaultRcvBuffSize )
::InetRcvBufSize( SocketCon, ::nDefaultRcvBuffSize )
ENDIF
if ::lTrace
::Log( cServer, nPort, SocketCon )
endif
Return Nil
client.prg 559 TIPCLIENT:METHOD InetRcvBufSize( SocketCon, nSizeBuff ) CLASS tIPClient
METHOD InetRcvBufSize( SocketCon, nSizeBuff ) CLASS tIPClient
IF ! Empty( nSizeBuff )
HB_InetSetRcvBufSize( SocketCon, nSizeBuff )
ENDIF
RETURN HB_InetGetRcvBufSize( SocketCon )
client.prg 580 TIPCLIENT:METHOD InetSndBufSize( SocketCon, nSizeBuff ) CLASS tIPClient
METHOD InetSndBufSize( SocketCon, nSizeBuff ) CLASS tIPClient
IF ! Empty( nSizeBuff )
HB_InetSetSndBufSize( SocketCon, nSizeBuff )
ENDIF
RETURN HB_InetGetSndBufSize( SocketCon )
client.prg 586 TIPCLIENT:METHOD Log( ... ) CLASS tIPClient
METHOD Log( ... ) CLASS tIPClient
LOCAL xVar
LOCAL cMsg := DToS( Date() ) + "-" + Time() + Space( 2 ) + ;
SubStr( ProcName( 1 ), Rat( ":", ProcName( 1 ) ) ) +;
"( "
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
cMsg += hb_CStr( xVar )
endif
cMsg += iif ( xVar:__enumIndex() < PCount() - 1, ", ", "" )
if xVar:__enumIndex() == PCount() - 1
cMsg += " )" + hb_OsNewLine() + ">> "
elseif xVar:__enumIndex() == PCount()
cMsg += " <<" + hb_OsNewLine() + hb_OsNewLine()
endif
next
fWrite( ::nHandle, cMsg )
RETURN Self
client.prg 597 credent.prg Type Function Source Line CLASS tIPCredentials
CLASS tIPCredentials
DATA cMethod
DATA cUserid
DATA cPassword
ENDCLASS
credent.prg 61 encb64.prg Type Function Source Line CLASS TIPEncoderBase64 FROM TIPEncoder
CLASS TIPEncoderBase64 FROM TIPEncoder
// Set this to .T. to enable RFC 2068 (HTTP/1.1) exception to
// RFC 2045 (MIME) base64 format. This exception consists in
// not applying CRLF after each 76 output bytes.
DATA bHttpExcept
METHOD New() Constructor
METHOD Encode( cData )
METHOD Decode( cData )
ENDCLASS
encb64.prg 56 TIPENCODERBASE64:METHOD New() CLASS TIPEncoderBase64
METHOD New() CLASS TIPEncoderBase64
::cName := "Base64"
::bHttpExcept := .F.
RETURN Self
encb64.prg 67 encoder.prg Type Function Source Line FUNCTION TIp_GetEncoder( cModel )
FUNCTION TIp_GetEncoder( cModel )
LOCAL oEncoder
IF !( Valtype( cModel ) == "C" )
cModel := "as-is"
ENDIF
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
encoder.prg 69 CLASS TIPEncoder
CLASS TIPEncoder
DATA cName
METHOD New( cModel )
METHOD Encode( cData )
METHOD Decode( cData )
ENDCLASS
encoder.prg 101 TIPENCODER:METHOD New( cModel ) class TIPEncoder
METHOD New( cModel ) class TIPEncoder
IF !( Valtype( cModel ) == "C" )
cModel := "as-is"
ENDIF
::cName := cModel
RETURN self
encoder.prg 110 TIPENCODER:METHOD Encode( cData ) class TIPEncoder
METHOD Encode( cData ) class TIPEncoder
RETURN cData
encoder.prg 118 TIPENCODER:METHOD Decode( cData ) class TIPEncoder
METHOD Decode( cData ) class TIPEncoder
RETURN cData
encoder.prg 121 encqp.prg Type Function Source Line CLASS TIPEncoderQP FROM TIPEncoder
CLASS TIPEncoderQP FROM TIPEncoder
METHOD New() Constructor
METHOD Encode( cData )
METHOD Decode( cData )
ENDCLASS
encqp.prg 57 TIPENCODERQP:METHOD New() CLASS TIPEncoderQP
METHOD New() CLASS TIPEncoderQP
::cName := "Quoted-Printable"
RETURN Self
encqp.prg 63 encurl.prg Type Function Source Line CLASS TIPEncoderUrl FROM TIPEncoder
CLASS TIPEncoderUrl FROM TIPEncoder
METHOD New() Constructor
METHOD Encode()
METHOD Decode()
ENDCLASS
encurl.prg 57 TIPENCODERURL:METHOD New() CLASS TIPEncoderURL
METHOD New() CLASS TIPEncoderURL
::cName := "urlencoded"
RETURN Self
encurl.prg 63 ftpcln.prg Type Function Source Line CLASS tIPClientFTP FROM tIPClient
CLASS tIPClientFTP FROM tIPClient
DATA nDataPort
DATA cDataServer
DATA bUsePasv
DATA RegBytes
DATA RegPasv
// Socket opened in response to a port command
DATA SocketControl
DATA SocketPortServer
DATA cLogFile
METHOD New( oUrl, lTrace, oCredentials )
METHOD Open()
METHOD Read( nLen )
METHOD Write( nLen )
METHOD Close()
METHOD TransferStart()
METHOD Commit()
METHOD GetReply()
METHOD Pasv()
METHOD TypeI()
METHOD TypeA()
METHOD NoOp()
METHOD Rest( nPos )
METHOD List( cSpec )
METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply )
METHOD Pwd()
METHOD Cwd( cPath )
METHOD Dele( cPath )
METHOD Port()
METHOD SendPort()
METHOD Retr( cFile )
METHOD Stor( cFile )
METHOD Quit()
METHOD ScanLength()
METHOD ReadAuxPort()
METHOD mget()
// Method bellow 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 RMD( cPath )
METHOD listFiles( cList )
METHOD MPut
METHOD StartCleanLogFile()
METHOD fileSize( cFileSpec )
ENDCLASS
ftpcln.prg 109 TIPCLIENTFTP:METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP
METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP
local cFile :="ftp"
local n := 0
::super:new( oUrl, lTrace, oCredentials)
::nDefaultPort := 21
::nConnTimeout := 3000
::bUsePasv := .T.
::nAccessMode := TIP_RW // a read-write protocol
::nDefaultSndBuffSize := 65536
::nDefaultRcvBuffSize := 65536
if ::ltrace
if !file("ftp.log")
::nHandle := fcreate("ftp.log")
else
while file(cFile+LTrim(str(Int(n)))+".log")
n++
enddo
::cLogFile:= cFile+LTrim(str(Int(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
ftpcln.prg 166 TIPCLIENTFTP:METHOD StartCleanLogFile() CLASS tIPClientFTP
METHOD StartCleanLogFile() CLASS tIPClientFTP
fclose(::nHandle)
::nHandle := fcreate(::cLogFile)
RETURN NIL
ftpcln.prg 197 TIPCLIENTFTP:METHOD Open( cUrl ) CLASS tIPClientFTP
METHOD Open( cUrl ) CLASS tIPClientFTP
IF HB_IsString( cUrl )
::oUrl := tUrl():New( cUrl )
ENDIF
IF Len( ::oUrl:cUserid ) == 0 .or. Len( ::oUrl:cPassword ) == 0
RETURN .F.
ENDIF
IF .not. ::super:Open()
RETURN .F.
ENDIF
HB_InetTimeout( ::SocketCon, ::nConnTimeout )
IF ::GetReply()
::InetSendall( ::SocketCon, "USER " + ::oUrl:cUserid + ::cCRLF )
IF ::GetReply()
::InetSendall( ::SocketCon, "PASS " + ::oUrl:cPassword + ::cCRLF )
// set binary by default
IF ::GetReply() .and. ::TypeI()
RETURN .T.
ENDIF
ENDIF
ENDIF
RETURN .F.
ftpcln.prg 203 TIPCLIENTFTP:METHOD GetReply() CLASS tIPClientFTP
METHOD GetReply() CLASS tIPClientFTP
LOCAL nLen
LOCAL cRep
::cReply := ::InetRecvLine( ::SocketCon, @nLen, 128 )
cRep := ::cReply
IF cRep == NIL
RETURN .F.
ENDIF
// now, if the reply has a "-" as fourth character, we need to proceed...
DO WHILE .not. Empty(cRep) .and. SubStr( cRep, 4, 1 ) == "-"
::cReply := ::InetRecvLine( ::SocketCon, @nLen, 128 )
cRep := IIf(ValType(::cReply) == "C", ::cReply, "")
ENDDO
// 4 and 5 are error codes
IF ::InetErrorCode( ::SocketCon ) != 0 .or. Left( ::cReply, 1 ) >= "4"
RETURN .F.
ENDIF
RETURN .T.
ftpcln.prg 230 TIPCLIENTFTP:METHOD Pasv() CLASS tIPClientFTP
METHOD Pasv() CLASS tIPClientFTP
LOCAL aRep
::InetSendall( ::SocketCon, "PASV" + ::cCRLF )
IF .not. ::GetReply()
RETURN .F.
ENDIF
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.
ftpcln.prg 255 TIPCLIENTFTP:METHOD Close() CLASS tIPClientFTP
METHOD Close() CLASS tIPClientFTP
HB_InetTimeOut( ::SocketCon, ::nConnTimeout )
if ::ltrace
fClose(::nHandle)
endif
::Quit()
RETURN ::super:Close()
ftpcln.prg 274 TIPCLIENTFTP:METHOD Quit() CLASS tIPClientFTP
METHOD Quit() CLASS tIPClientFTP
::InetSendall( ::SocketCon, "QUIT" + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 284 TIPCLIENTFTP:METHOD TypeI() CLASS tIPClientFTP
METHOD TypeI() CLASS tIPClientFTP
::InetSendall( ::SocketCon, "TYPE I" + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 289 TIPCLIENTFTP:METHOD TypeA() CLASS tIPClientFTP
METHOD TypeA() CLASS tIPClientFTP
::InetSendall( ::SocketCon, "TYPE A" + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 294 TIPCLIENTFTP:METHOD NoOp() CLASS tIPClientFTP
METHOD NoOp() CLASS tIPClientFTP
::InetSendall( ::SocketCon, "NOOP" + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 299 TIPCLIENTFTP:METHOD Rest( nPos ) CLASS tIPClientFTP
METHOD Rest( nPos ) CLASS tIPClientFTP
::InetSendall( ::SocketCon, "REST " + AllTrim( Str( iif( Empty( nPos ), 0, nPos ) ) ) + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 304 TIPCLIENTFTP:METHOD CWD( cPath ) CLASS tIPClientFTP
METHOD CWD( cPath ) CLASS tIPClientFTP
::InetSendall( ::SocketCon, "CWD " + cPath + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 309 TIPCLIENTFTP:METHOD PWD() CLASS tIPClientFTP
METHOD PWD() CLASS tIPClientFTP
::InetSendall( ::SocketCon, "PWD" + ::cCRLF )
IF .not. ::GetReply()
RETURN .F.
ENDIF
::cReply := SubStr( ::cReply, At('"', ::cReply) + 1, ;
Rat('"', ::cReply) - At('"', ::cReply) - 1 )
RETURN .T.
ftpcln.prg 314 TIPCLIENTFTP:METHOD DELE( cPath ) CLASS tIPClientFTP
METHOD DELE( cPath ) CLASS tIPClientFTP
::InetSendall( ::SocketCon, "DELE " + cPath + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 325 TIPCLIENTFTP:METHOD ScanLength() CLASS tIPClientFTP
METHOD ScanLength() CLASS tIPClientFTP
LOCAL aBytes
aBytes := HB_Regex( ::RegBytes, ::cReply )
IF .not. Empty(aBytes)
::nLength := Val( aBytes[2] )
ENDIF
RETURN .T.
ftpcln.prg 331 TIPCLIENTFTP:METHOD TransferStart() CLASS tIPClientFTP
METHOD TransferStart() CLASS tIPClientFTP
LOCAL skt
::SocketControl := ::SocketCon
IF ::bUsePasv
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 )
RETURN .F.
ENDIF
HB_InetTimeout( skt, ::nConnTimeout )
/* Set internal socket send buffer to 64k,
* this should fix the speed problems some users have reported
*/
IF ! Empty( ::nDefaultSndBuffSize )
::InetSndBufSize( skt, ::nDefaultSndBuffSize )
ENDIF
IF ! Empty( ::nDefaultRcvBuffSize )
::InetRcvBufSize( skt, ::nDefaultRcvBuffSize )
ENDIF
::SocketCon := skt
ENDIF
ELSE
::SocketCon := HB_InetAccept( ::SocketPortServer )
IF Empty( ::SocketCon )
::bInitialized := .F.
::SocketCon := ::SocketControl
::GetReply()
RETURN .F.
ENDIF
HB_InetSetRcvBufSize( ::SocketCon, 65536 )
HB_InetSetSndBufSize( ::SocketCon, 65536 )
ENDIF
RETURN .T.
ftpcln.prg 340 TIPCLIENTFTP:METHOD Commit() CLASS tIPClientFTP
METHOD Commit() CLASS tIPClientFTP
HB_InetClose( ::SocketCon )
::SocketCon := ::SocketControl
::bInitialized := .F.
IF .not. ::GetReply()
RETURN .F.
ENDIF
// error code?
IF Left( ::cReply, 1 ) == "5"
RETURN .F.
ENDIF
RETURN .T.
ftpcln.prg 382 TIPCLIENTFTP:METHOD List( cSpec ) CLASS tIPClientFTP
METHOD List( cSpec ) CLASS tIPClientFTP
LOCAL cStr
IF cSpec == nil
cSpec := ""
ELSE
cSpec := " " + cSpec
ENDIF
IF ::bUsePasv
IF .not. ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
ENDIF
IF .not. ::bUsePasv
IF .not. ::Port()
RETURN .F.
ENDIF
ENDIF
::InetSendAll( ::SocketCon, "LIST" + cSpec + ::cCRLF )
cStr := ::ReadAuxPort()
::bEof := .f.
RETURN cStr
ftpcln.prg 399 TIPCLIENTFTP:METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP
METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP
DEFAULT cCommand TO ""
DEFAULT lPasv TO .t.
DEFAULT lReadPort TO .t.
DEFAULT lGetReply TO .f.
if ::bUsePasv .and. lPasv .and. !::Pasv()
return .f.
endif
::InetSendAll( ::SocketCon, cCommand )
if lReadPort
lReadPort := ::ReadAuxPort()
endif
if lGetReply
lGetReply := ::GetReply()
endif
RETURN .t.
ftpcln.prg 425 TIPCLIENTFTP:METHOD ReadAuxPort(cLocalFile) CLASS tIPClientFTP
METHOD ReadAuxPort(cLocalFile) CLASS tIPClientFTP
LOCAL cRet, cList := "",nFile:=0
IF .not. ::TransferStart()
RETURN NIL
END
IF !empty(cLocalFile)
nFile:=fcreate(cLocalFile)
ENDIF
cRet := ::super:Read( 512 )
WHILE cRet != NIL .and. len( cRet ) > 0
IF nFile>0
fwrite(nFile,cRet)
else
cList += cRet
ENDIF
cRet := ::super:Read( 512 )
END
HB_InetClose( ::SocketCon )
::SocketCon := ::SocketControl
IF ::GetReply()
IF nFile>0
fclose(nFile)
return(.t.)
ENDIF
RETURN cList
ENDIF
RETURN NIL
ftpcln.prg 449 TIPCLIENTFTP:METHOD Stor( cFile ) CLASS tIPClientFTP
METHOD Stor( cFile ) CLASS tIPClientFTP
IF ::bUsePasv
IF .not. ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
ENDIF
::InetSendall( ::SocketCon, "STOR " + cFile + ::cCRLF )
// It is important not to delete these lines in order not to disrupt the timing of
// the responses, which can lead to failures in transfers.
IF ! ::bUsePasv
::GetReply()
ENDIF
RETURN ::TransferStart()
ftpcln.prg 480 TIPCLIENTFTP:METHOD Port() CLASS tIPClientFTP
METHOD Port() CLASS tIPClientFTP
::SocketPortServer := HB_InetCreate( ::nConnTimeout )
s_nPort ++
DO WHILE s_nPort < 24000
HB_InetServer( s_nPort, ::SocketPortServer )
IF ::InetErrorCode( ::SocketPortServer ) == 0
RETURN ::SendPort()
ENDIF
s_nPort ++
ENDDO
RETURN .F.
ftpcln.prg 500 TIPCLIENTFTP:METHOD SendPort() CLASS tIPClientFTP
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 ) ) )
::InetSendall( ::SocketCon, "PORT " + cAddr + cPort + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 515 TIPCLIENTFTP:METHOD Read( nLen ) CLASS tIPClientFTP
METHOD Read( nLen ) CLASS tIPClientFTP
LOCAL cRet
IF .not. ::bInitialized
IF .not. Empty( ::oUrl:cPath )
IF .not. ::CWD( ::oUrl:cPath )
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF
ENDIF
IF Empty( ::oUrl:cFile )
RETURN ::List()
ENDIF
IF .not. ::Retr( ::oUrl:cFile )
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF
// now channel is open
::bInitialized := .T.
ENDIF
cRet := ::super:Read( nLen )
IF cRet == NIL
::Commit()
::bEof := .T.
ENDIF
RETURN cRet
*
* FTP transfer wants commit only at end.
*
ftpcln.prg 528 TIPCLIENTFTP:METHOD Write( cData, nLen ) CLASS tIPClientFTP
METHOD Write( cData, nLen ) CLASS tIPClientFTP
IF .not. ::bInitialized
IF Empty( ::oUrl:cFile )
RETURN -1
ENDIF
IF .not. Empty( ::oUrl:cPath )
IF .not. ::CWD( ::oUrl:cPath )
RETURN -1
ENDIF
ENDIF
IF .not. ::Stor( ::oUrl:cFile )
RETURN -1
ENDIF
// now channel is open
::bInitialized := .T.
ENDIF
RETURN ::super:Write( cData, nLen, .F. )
ftpcln.prg 576 TIPCLIENTFTP:METHOD Retr( cFile ) CLASS tIPClientFTP
METHOD Retr( cFile ) CLASS tIPClientFTP
IF ::bUsePasv
IF .not. ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
ENDIF
::InetSendAll( ::SocketCon, "RETR " + cFile + ::cCRLF )
IF ::TransferStart()
::ScanLength()
RETURN .T.
ENDIF
RETURN .F.
ftpcln.prg 608 TIPCLIENTFTP:METHOD MGET( cSpec,cLocalPath ) CLASS tIPClientFTP
METHOD MGET( cSpec,cLocalPath ) CLASS tIPClientFTP
LOCAL cStr,cfile,aFiles
IF cSpec == nil
cSpec := ""
ENDIF
IF cLocalPath == nil
cLocalPath:=""
ENDIF
IF ::bUsePasv
IF .not. ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
ENDIF
::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) )
ENDIF
NEXT
ENDIF
RETURN cStr
ftpcln.prg 626 TIPCLIENTFTP:METHOD MPUT( cFileSpec, cAttr ) CLASS tIPClientFTP
METHOD MPUT( cFileSpec, cAttr ) CLASS tIPClientFTP
LOCAL cPath,cFile, cExt, aFile, aFiles
LOCAL nCount := 0
LOCAL cStr := ""
IF !( Valtype( cFileSpec ) == "C" )
RETURN 0
ENDIF
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]
ENDIF
NEXT
RETURN SubStr(cStr,3)
ftpcln.prg 658 TIPCLIENTFTP:METHOD UpLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP
METHOD UpLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP
LOCAL cPath := ""
LOCAL cFile := ""
LOCAL cExt := ""
HB_FNameSplit( cLocalFile, @cPath, @cFile,@cExt )
DEFAULT cRemoteFile to cFile + cExt
::bEof := .F.
::oUrl:cFile := cRemoteFile
IF ! ::bInitialized
IF Empty( ::oUrl:cFile )
RETURN .F.
ENDIF
IF ! Empty( ::oUrl:cPath )
IF ! ::CWD( ::oUrl:cPath )
RETURN .F.
ENDIF
ENDIF
IF ! ::bUsePasv .AND. ! ::Port()
RETURN .F.
ENDIF
IF ! ::Stor( ::oUrl:cFile )
RETURN .F.
ENDIF
// now channel is open
::bInitialized := .T.
ENDIF
RETURN ::WriteFromFile( cLocalFile )
ftpcln.prg 680 TIPCLIENTFTP:METHOD LS( cSpec ) CLASS tIPClientFTP
METHOD LS( cSpec ) CLASS tIPClientFTP
LOCAL cStr
IF cSpec == nil
cSpec := ""
ENDIF
IF ::bUsePasv .AND. ! ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
IF ! ::bUsePasv .AND. ! ::Port()
RETURN .F.
ENDIF
::InetSendAll( ::SocketCon, "NLST " + cSpec + ::cCRLF )
IF ::GetReply()
cStr := ::ReadAuxPort()
ELSE
cStr := ""
ENDIF
RETURN cStr
ftpcln.prg 722 TIPCLIENTFTP:METHOD Rename( cFrom, cTo ) CLASS tIPClientFTP
METHOD Rename( cFrom, cTo ) CLASS tIPClientFTP
Local lResult := .F.
::InetSendAll( ::SocketCon, "RNFR " + cFrom + ::cCRLF )
IF ::GetReply()
::InetSendAll( ::SocketCon, "RNTO " + cTo + ::cCRLF )
lResult := ::GetReply()
ENDIF
RETURN lResult
ftpcln.prg 750 TIPCLIENTFTP:METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP
METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP
LOCAL cPath := ""
LOCAL cFile := ""
LOCAL cExt := ""
HB_FNameSplit( cLocalFile, @cPath, @cFile, @cExt )
DEFAULT cRemoteFile to cFile+cExt
::bEof := .F.
::oUrl:cFile := cRemoteFile
IF ! ::bInitialized
IF ! Empty( ::oUrl:cPath ) .AND. ! ::CWD( ::oUrl:cPath )
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF
IF ! ::bUsePasv .AND. ! ::Port()
RETURN .F.
ENDIF
IF ! ::Retr( ::oUrl:cFile )
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF
// now channel is open
::bInitialized := .T.
ENDIF
RETURN ::ReadToFile( cLocalFile, , ::nLength )
ftpcln.prg 764 TIPCLIENTFTP:METHOD MKD( cPath ) CLASS tIPClientFTP
METHOD MKD( cPath ) CLASS tIPClientFTP
::InetSendall( ::SocketCon, "MKD " + cPath + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 803 TIPCLIENTFTP:METHOD RMD( cPath ) CLASS tIPClientFTP
METHOD RMD( cPath ) CLASS tIPClientFTP
::InetSendall( ::SocketCon, "RMD " + cPath + ::cCRLF )
RETURN ::GetReply()
ftpcln.prg 809 TIPCLIENTFTP:METHOD fileSize( cFileSpec ) CLASS tIPClientFTP
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] ?
NEXT
RETURN nSize
ftpcln.prg 815 TIPCLIENTFTP:METHOD listFiles( cFileSpec ) CLASS tIPClientFTP
METHOD listFiles( cFileSpec ) CLASS tIPClientFTP
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
cList := ::list( cFileSpec )
IF Empty( cList )
RETURN {}
ENDIF
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()
hb_ADel(aList, cEntry:__enumIndex(), .T.)
ELSE
aFile := Array( F_LEN+3 )
nStart := 1
nEnd := hb_At( Chr(32), cEntry, nStart )
// file permissions (attributes)
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
// 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
// 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
// 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
// Month
DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO
nEnd := hb_At( Chr(32), 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 )
nStart := nEnd
// year
DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO
nEnd := hb_At( Chr(32), cEntry, nStart )
cYear := SubStr( cEntry, nStart, nEnd-nStart )
nStart := nEnd
IF ":" $ cYear
cTime := cYear
cYear := Str( Year(Date()), 4, 0 )
ELSE
cTime := ""
ENDIF
// 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
aList[ cEntry:__enumIndex() ] := aFile
ENDIF
NEXT
RETURN aList
ftpcln.prg 824 httpcln.prg Type Function Source Line CLASS tIPClientHTTP FROM tIPClient
CLASS tIPClientHTTP FROM tIPClient
DATA cMethod
DATA nReplyCode
DATA cReplyDescr
DATA nVersion INIT 1
DATA nSubversion INIT 0
DATA bChunked
DATA hHeaders INIT {=>}
DATA hCookies INIT {=>}
DATA hFields INIT {=>}
DATA cUserAgent INIT "Mozilla/3.0 compatible"
DATA cAuthMode INIT ""
DATA cBoundary
DATA aAttachments init {}
METHOD New( oUrl,lTrace, oCredentials)
METHOD Get( cQuery )
METHOD Post( cPostData, cQuery )
METHOD ReadHeaders()
METHOD Read( nLen )
httpcln.prg 62 TIPCLIENTHTTP:METHOD UseBasicAuth()
METHOD UseBasicAuth() INLINE ::cAuthMode := "Basic"
Method ReadAll()
Method SetCookie
Method GetCookies
Method Boundary
METHOD Attach(cName,cFileName,cType)
Method PostMultiPart
Method WriteAll( cFile )
HIDDEN:
METHOD StandardFields()
ENDCLASS
httpcln.prg 82 TIPCLIENTHTTP: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
httpcln.prg 96 TIPCLIENTHTTP:METHOD Get( cQuery ) CLASS tIPClientHTTP
METHOD Get( cQuery ) CLASS tIPClientHTTP
IF .not. HB_IsString( cQuery )
cQuery := ::oUrl:BuildQuery()
ENDIF
::InetSendall( ::SocketCon, "GET " + cQuery + " HTTP/1.1" + ::cCRLF )
::StandardFields()
::InetSendall( ::SocketCon, ::cCRLF )
IF ::InetErrorCode( ::SocketCon ) == 0
RETURN ::ReadHeaders()
ENDIF
RETURN .F.
httpcln.prg 106 TIPCLIENTHTTP:METHOD Post( cPostData, cQuery ) CLASS tIPClientHTTP
METHOD Post( cPostData, cQuery ) CLASS tIPClientHTTP
LOCAL cData, nI, cTmp,y
IF HB_IsHash( cPostData )
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)
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 )
cData += cTmp
IF nI!=y
cData+="&"
ENDIF
NEXT
ELSEIF HB_IsString( cPostData )
cData := cPostData
ELSE
Alert( "TipClientHTTP_PostRequest: Invalid parameters" )
RETURN .F.
ENDIF
IF .not. HB_IsString( cQuery )
cQuery := ::oUrl:BuildQuery()
ENDIF
::InetSendall( ::SocketCon, "POST " + cQuery + " HTTP/1.1" + ::cCRLF )
::StandardFields()
IF .not. "Content-Type" $ ::hFields
::InetSendall( ::SocketCon, e"Content-Type: application/x-www-form-urlencoded\r\n" )
ENDIF
::InetSendall( ::SocketCon, "Content-Length: " + ;
LTrim(Str( Len( cData ) ) ) + ::cCRLF )
// End of header
::InetSendall( ::SocketCon, ::cCRLF )
IF ::InetErrorCode( ::SocketCon ) == 0
::InetSendall( ::SocketCon, cData )
::bInitialized := .T.
RETURN ::ReadHeaders()
/* else
alert("Post HB_InetErrorCode:"+winsockerrorcode(::InetErrorCode( ::SocketCon )))*/
ENDIF
RETURN .F.
httpcln.prg 120 TIPCLIENTHTTP:METHOD StandardFields() CLASS tIPClientHTTP
METHOD StandardFields() CLASS tIPClientHTTP
LOCAL iCount
LOCAL oEncoder,cCookies
::InetSendall( ::SocketCon, "Host: " + ::oUrl:cServer + ::cCRLF )
::InetSendall( ::SocketCon, "User-agent: " + ::cUserAgent + ::cCRLF )
::InetSendall( ::SocketCon, "Connection: close" + ::cCRLF )
// Perform a basic authentication request
IF ::cAuthMode == "Basic" .and. .not. ("Authorization" $ ::hFields)
oEncoder := TIPEncoderBase64():New()
oEncoder:bHttpExcept := .T.
::InetSendall( ::SocketCon, "Authorization: Basic " +;
oEncoder:Encode( ::oUrl:cUserID + ":" + ::oUrl:cPassword ) + ::cCRLF )
ENDIF
// send cookies
cCookies:=::getCookies()
IF ! Empty( cCookies )
::InetSendall( ::SocketCon, "Cookie: " + cCookies+::cCRLF)
ENDIF
//Send optional Fields
FOR iCount := 1 TO Len( ::hFields )
::InetSendall( ::SocketCon, hb_HKeyAt( ::hFields, iCount ) +;
": " + hb_HValueAt( ::hFields, iCount ) + ::cCRLF )
NEXT
RETURN .T.
httpcln.prg 188 TIPCLIENTHTTP:METHOD ReadHeaders(lClear) CLASS tIPClientHTTP
METHOD ReadHeaders(lClear) CLASS tIPClientHTTP
LOCAL cLine, nPos, aVersion
LOCAL aHead
// Now reads the fields and set the content lenght
cLine := ::InetRecvLine( ::SocketCon, @nPos, 500 )
IF Empty( cLine )
// In case of timeout or error on receiving
RETURN .F.
ENDIF
// Get Protocol version
aVersion := HB_Regex( "^HTTP/(.)\.(.) ([0-9][0-9][0-9]) +(.*)$", cLine )
::cReply := cLine
IF aVersion == NIL
::nVersion := 0
::nSubversion := 9
::nReplyCode := 0
::cReplyDescr := ""
ELSE
::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:={=>}
ENDIF
DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .and. .not. Empty( cLine )
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])
DO CASE
// RFC 2068 forces to discard content length on chunked encoding
CASE lower( aHead[1] ) == "content-length" .and. .not. ::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])
ENDCASE
cLine := ::InetRecvLine( ::SocketCon, @nPos, 500 )
ENDDO
IF ::InetErrorCode( ::SocketCon ) != 0
RETURN .F.
ENDIF
RETURN .T.
httpcln.prg 221 TIPCLIENTHTTP:METHOD Read( nLen ) CLASS tIPClientHTTP
METHOD Read( nLen ) CLASS tIPClientHTTP
LOCAL cData, nPos, cLine, aHead
IF .not. ::bInitialized
::bInitialized := .T.
IF .not. ::Get()
RETURN NIL
ENDIF
ENDIF
/* On HTTP/1.1 protocol, content lenght can be in hex format before each chunk.
The chunk header is read each time nLength is -1; While reading the chunk,
nLenght is set to nRead plus the expected chunk size. After reading the
chunk, the footer is discarded, and nLenght is reset to -1.
*/
IF ::nLength == -1 .and. ::bChunked
cLine := ::InetRecvLine( ::SocketCon, @nPos, 1024 )
IF Empty( cLine )
RETURN NIL
ENDIF
// if this is the last chunk ...
IF cLine == "0"
// read the footers.
cLine := ::InetRecvLine( ::SocketCon, @nPos, 1024 )
DO WHILE .not. Empty( cLine )
// add Headers to footers
aHead := HB_RegexSplit( ":", cLine,,, 1 )
IF aHead != NIL
::hHeaders[ aHead[1] ] := LTrim(aHead[2])
ENDIF
cLine := ::InetRecvLine( ::SocketCon, @nPos, 1024 )
ENDDO
// we are done
::bEof := .T.
RETURN NIL
ENDIF
// A normal chunk here
// Remove the extensions
nPos := at( ";", cLine )
IF nPos > 0
cLine := Substr( cLine, 1, nPos - 1 )
ENDIF
// Convert to length
// Set length so that super::Read reads in at max cLine bytes.
::nLength := hb_HexToNum( cLine ) + ::nRead
ENDIF
// nLen is normalized by super:read()
cData := ::super:Read( nLen )
// If bEof is set with chunked encoding, this means that the whole chunk has been read;
IF ::bEof .and. ::bChunked
::bEof := .F.
::nLength := -1
//chunked data is followed by a blank line
cLine := ::InetRecvLine( ::SocketCon, @nPos, 1024 )
ENDIF
RETURN cData
httpcln.prg 287 TIPCLIENTHTTP:METHOD ReadAll() CLASS tIPClientHTTP
METHOD ReadAll() CLASS tIPClientHTTP
local cOut:="", cChunk
IF .not. ::bInitialized
::bInitialized := .T.
IF .not. ::Get()
RETURN NIL
ENDIF
ENDIF
IF ::bChunked
cChunk:=::read()
while cChunk != nil
cOut+=cChunk
// ::nLength:=-1
cChunk:=::read()
end
else
return(::read())
endif
return(cOut)
httpcln.prg 357 TIPCLIENTHTTP: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:="/"
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
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
ENDIF
ENDIF
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
ENDIF
return NIL
httpcln.prg 378 TIPCLIENTHTTP:METHOD getcookies(cHost,cPath) CLASS tIPClientHTTP
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
IF cPath == nil
cPath:=::oUrl:cPath
IF empty(cPath)
cPath:="/"
ENDIF
ENDIF
IF empty(cHost)
return(cOut)
ENDIF
//tail matching the domain
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])
ENDIF
NEXT
//more specific paths should be sent before lesser generic paths.
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)
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])
ENDIF
NEXT
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)
FOR c := 1 TO d
IF !empty(cOut)
cOut+="; "
ENDIF
cOut+=aKeys[c]+"="+::hCookies[aDomKeys[x]][aPathKeys[a]][aKeys[c]]
NEXT
NEXT
NEXT
return(cOut)
httpcln.prg 425 TIPCLIENTHTTP: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
Examples:
-----------------------------41184676334 //in the body or stdin stream
-----------------------------41184676334-- //last one of the stdin stream
---------------------------41184676334 //in the header or CGI envirnment
*/
local cBound:=::cBoundary
LOCAL i
IF nType == nil
nType := 0
ENDIF
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) )
NEXT
::cBoundary:=cBound
endif
cBound:=iif(nType<2,"--","")+cBound+iif(nType == 1,"--","")
RETURN(cBound)
httpcln.prg 483 TIPCLIENTHTTP:METHOD Attach(cName,cFileName,cType) CLASS tIPClientHTTP
METHOD Attach(cName,cFileName,cType) CLASS tIPClientHTTP
aadd(::aAttachments,{cName,cFileName,cType})
return(nil)
httpcln.prg 509 TIPCLIENTHTTP:METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP
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
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 )
else
cFilePath := ""
endif
cTmp:=substr(cFile,Len(cFilePath)+1)
IF empty(cType)
cType:="text/html"
ENDIF
cData += cBound+cCrlf+'Content-Disposition: form-data; name="'+cName +'"; filename="'+cTmp+'"'+cCrlf+'Content-Type: '+cType+cCrLf+cCrLf
//hope this is not a big file....
nFile:=fopen(cFile)
nbuf:=8192
nRead:=nBuf
cBuf:=space(nBuf)
while nRead == nBuf
//nRead := FRead( nFile,@cBuf,nBuf)
cBuf:=FReadstr( nFile,nBuf)
nRead:=len(cBuf)
/* IF nReadhttpcln.prg 513 TIPCLIENTHTTP:METHOD WriteAll( cFile ) CLASS tIPClientHTTP
METHOD WriteAll( cFile ) CLASS tIPClientHTTP
local nFile
local lSuccess
local nLen
local cStream
cStream := ::ReadAll()
nLen := len( cStream )
nFile := fcreate( cFile )
if nFile != 0
lSuccess := ( fwrite( nFile, cStream, nLen ) == nLen )
fclose( nFile )
else
lSuccess := .f.
endif
RETURN lSuccess
httpcln.prg 613 mail.prg Type Function Source Line CLASS TipMail
CLASS TipMail
DATA hHeaders
// received fields may be more than once.
DATA aReceived INIT {}
METHOD New(cBody, oEncoder ) Constructor
METHOD SetBody( cBody )
METHOD GetBody()
mail.prg 65 TIPMAIL:METHOD GetRawBody()
METHOD GetRawBody() INLINE ::cBody
METHOD SetEncoder( cEncoder )
/*
METHOD FWrite( nFile )
METHOD FRead( nFile )
METHOD Send( sSocket )
METHOD Recv( sSocket )
*/
METHOD FromString( cString )
METHOD ToString()
METHOD GetFieldPart( cField )
METHOD GetFieldOption( cField )
METHOD SetFieldPart( cField, cValue )
METHOD SetFieldOption( cField, cValue )
mail.prg 73 TIPMAIL:METHOD GetContentType()
METHOD GetContentType() INLINE ::GetFieldPart( "Content-Type" )
mail.prg 90 TIPMAIL:METHOD GetCharEncoding()
METHOD GetCharEncoding() INLINE ::GetFieldOption( "Content-Type", "encoding" )
METHOD Attach( oSubPart )
METHOD NextAttachment()
mail.prg 91 TIPMAIL:METHOD CountAttachments()
METHOD CountAttachments() INLINE Len( ::aAttachments )
METHOD GetAttachment()
mail.prg 95 TIPMAIL:METHOD ResetAttachment()
METHOD ResetAttachment() INLINE ::nAttachPos := 1
METHOD MakeBoundary()
METHOD isMultiPart()
METHOD getMultiParts()
METHOD setHeader
METHOD attachFile( cFileName )
METHOD detachFile( cPath )
METHOD getFileName()
HIDDEN:
DATA cBody
Data lBodyEncoded init .f.
DATA oEncoder
DATA aAttachments
DATA nAttachPos INIT 1
ENDCLASS
mail.prg 97 TIPMAIL:METHOD New( cBody, oEncoder ) CLASS TipMail
METHOD New( cBody, oEncoder ) CLASS TipMail
// Set header fileds to non-sensitive
::hHeaders := hb_HSetCaseMatch( {=>}, .F. )
::aAttachments := {}
IF Valtype( oEncoder ) $ "CO"
::setEncoder( oEncoder )
ENDIF
IF cBody != NIL
IF ::oEncoder != NIL
::cBody := ::oEncoder:Encode( cBody )
::hHeaders[ "Content-Transfer-Encoding" ] := ::oEncoder:cName
ELSE
::cBody := cBody
ENDIF
::hHeaders[ "Content-Length" ] := Ltrim( Str( Len( ::cBody ) ) )
ENDIF
RETURN Self
mail.prg 117 TIPMAIL:METHOD SetEncoder( cEnc ) CLASS TipMail
METHOD SetEncoder( cEnc ) CLASS TipMail
if HB_IsString( cEnc )
::oEncoder := TIp_GetEncoder( cEnc )
ELSE
::oEncoder := cEnc
ENDIF
::hHeaders[ "Content-transfer-encoding" ] := ::oEncoder:cName
RETURN .T.
mail.prg 140 TIPMAIL:METHOD SetBody( cBody ) CLASS TipMail
METHOD SetBody( cBody ) CLASS TipMail
IF ::oEncoder != NIL
::cBody := ::oEncoder:Encode( cBody )
::lBodyEncoded:=.t. //GD needed to prevent an extra crlf from being appended
ELSE
::cBody := cBody
ENDIF
//::hHeaders[ "Content-Length" ] := Ltrim( Str( Len( cBody ) ) ) //GD -not needed
RETURN .T.
mail.prg 151 TIPMAIL:METHOD GetBody() CLASS TipMail
METHOD GetBody() CLASS TipMail
IF ::cBody == NIL
RETURN NIL
ELSEIF ::oEncoder != NIL
RETURN ::oEncoder:Decode( ::cBody )
ENDIF
RETURN ::cBody
mail.prg 162 TIPMAIL:METHOD GetFieldPart( cPart ) CLASS TipMail
METHOD GetFieldPart( cPart ) CLASS TipMail
LOCAL nPos, cEnc
nPos := hb_HPos( ::hHeaders, cPart )
IF nPos == 0
RETURN ""
ELSE
cEnc := hb_HValueAt( ::hHeaders, nPos )
nPos := At( ";", cEnc )
IF nPos != 0
cEnc := Substr( cEnc, 1, nPos - 1)
ENDIF
ENDIF
RETURN cEnc
mail.prg 171 TIPMAIL:METHOD GetFieldOption( cPart, cOption ) CLASS TipMail
METHOD GetFieldOption( cPart, cOption ) CLASS TipMail
LOCAL nPos, aMatch
LOCAL cEnc
nPos := hb_HPos( ::hHeaders, cPart )
IF nPos == 0
RETURN ""
ELSE
cEnc := hb_HValueAt( ::hHeaders, nPos )
// Case insensitive check
aMatch := HB_Regex( ";\s*" + cOption +"\s*=\s*([^;]*)", cEnc, .F. )
IF aMatch != NIL
cEnc := aMatch[2]
ELSE
RETURN ""
ENDIF
ENDIF
RETURN cEnc
mail.prg 188 TIPMAIL:METHOD SetFieldPart( cPart, cValue ) CLASS TipMail
METHOD SetFieldPart( cPart, cValue ) CLASS TipMail
LOCAL nPos, cEnc
nPos := hb_HPos( ::hHeaders, cPart )
IF nPos == 0
::hHeaders[ cPart ] := cValue
ELSE
cEnc := hb_HValueAt( ::hHeaders, nPos )
nPos := At( ";", cEnc )
IF nPos == 0
::hHeaders[ cPart ] := cValue
ELSE
::hHeaders[ cPart ] := cValue + Substr( cEnc, nPos )
ENDIF
ENDIF
RETURN .T.
mail.prg 208 TIPMAIL:METHOD SetFieldOption( cPart, cOption, cValue ) CLASS TipMail
METHOD SetFieldOption( cPart, cOption, cValue ) CLASS TipMail
LOCAL nPos, aMatch
LOCAL cEnc
nPos := hb_HPos( ::hHeaders, cPart )
IF nPos == 0
Return .F.
ELSE
cEnc := hb_HValueAt( ::hHeaders, nPos )
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]
ENDIF
ENDIF
RETURN .T.
mail.prg 227 TIPMAIL:METHOD Attach( oSubPart ) CLASS TipMail
METHOD Attach( oSubPart ) CLASS TipMail
IF HB_IsObject( oSubPart ) .and. oSubPart:ClassName == "TIPMAIL"
// reset wrong content-type
IF At( "multipart/", Lower( ::GetFieldPart("Content-Type")) ) == 0
::hHeaders[ "Content-Type" ] := "multipart/mixed"
ENDIF
AAdd( ::aAttachments, oSubPart )
RETURN .T.
ELSE
Alert( "TipMail:Attach() must be called with another TipMail object" )
ENDIF
RETURN .F.
mail.prg 248 TIPMAIL:METHOD NextAttachment() CLASS TipMail
METHOD NextAttachment() CLASS TipMail
IF ::nAttachPos > Len( ::aAttachments )
RETURN NIL
ELSE
::nAttachPos ++
ENDIF
RETURN ::aAttachments[ ::nAttachPos - 1 ]
mail.prg 265 TIPMAIL:METHOD GetAttachment() CLASS TipMail
METHOD GetAttachment() CLASS TipMail
IF ::nAttachPos > Len( ::aAttachments )
RETURN NIL
ENDIF
RETURN ::aAttachments[ ::nAttachPos ]
mail.prg 276 TIPMAIL:METHOD ToString() CLASS TipMail
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
//Reset failing content type
IF At( "multipart/", Lower( ::GetFieldPart("Content-Type")) ) == 0
::hHeaders[ "Content-Type" ] := "multipart/mixed"
ENDIF
// have we got it already?
cBoundary := ::GetFieldOption( "Content-Type", "Boundary" )
IF Empty( cBoundary )
cBoundary := ::MakeBoundary()
IF .not. ::SetFieldOption( "Content-Type", "Boundary", cBoundary )
::hHeaders[ "Content-Type" ] := ;
'multipart/mixed; boundary="' + cBoundary + '"'
ENDIF
ENDIF
ENDIF
// Begin output the fields
// Presenting them in a "well-known" order
IF "Return-Path" $ ::hHeaders
cRet += "Return-Path: "+::hHeaders[ "Return-Path" ] + e"\r\n"
ENDIF
IF "Delivered-To" $ ::hHeaders
cRet += "Delivered-To: "+::hHeaders[ "Delivered-To" ] + e"\r\n"
ENDIF
FOR EACH cElem IN ::aReceived
cRet += "Received: "+ cElem+ e"\r\n"
NEXT
IF "Date" $ ::hHeaders
cRet += "Date: "+::hHeaders[ "Date" ] + e"\r\n"
ENDIF
IF "From" $ ::hHeaders
cRet += "From: "+::hHeaders[ "From" ] + e"\r\n"
ENDIF
IF "To" $ ::hHeaders
cRet += "To: "+::hHeaders[ "To" ] + e"\r\n"
ENDIF
IF "Subject" $ ::hHeaders
cRet += "Subject: "+ ::hHeaders[ "Subject" ] + e"\r\n"
ENDIF
IF Len( ::aAttachments ) > 0
cRet += "Mime-Version:" + ::hHeaders[ "Mime-Version" ] + e"\r\n"
ENDIF
FOR i := 1 TO Len( ::hHeaders )
cElem := Lower(hb_HKeyAt( ::hHeaders, i ))
IF !( cElem == "return-path" ) .and.;
!( cElem == "delivered-to" ) .and.;
!( cElem == "date" ) .and.;
!( cElem == "from" ) .and.;
!( cElem == "to" ) .and.;
!( cElem == "subject" ) .and.;
!( cElem == "mime-version" )
cRet += hb_HKeyAt( ::hHeaders, i ) + ": " +;
hb_HValueAt( ::hHeaders, i ) + e"\r\n"
ENDIF
NEXT
// end of Header
cRet += e"\r\n"
//Body
IF .not. Empty( ::cBody )
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"
ENDIF
ENDIF
IF .not. Empty( ::aAttachments )
//Eventually go with mime multipart
FOR i := 1 TO Len(::aAttachments )
cRet += "--" + cBoundary + e"\r\n"
cRet += ::aAttachments[i]:ToString()
NEXT
cRet += "--" + cBoundary + "--" + e"\r\n"
ENDIF
RETURN cRet
mail.prg 285 TIPMAIL:METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail
METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail
LOCAL oSubSection, cSubBoundary
LOCAL nLinePos, nSplitPos, nBodyPos
LOCAL cValue, cLastField
IF Len( ::aAttachments ) > 0
::aAttachments := {}
ENDIF
IF Len( ::hHeaders ) > 0
::hHeaders := hb_HSetCaseMatch( {=>} , .F. )
ENDIF
IF Len( ::aReceived ) > 0
::aReceived := {}
ENDIF
// Part 1: parsing header
IF nPos == NIL
nPos := 1
ENDIF
nLinePos := hb_At( e"\r\n", cMail, nPos )
DO WHILE nLinePos > nPos
// going on with last field?
IF (SubStr( cMail, nPos, 1 ) == " " .or. SubStr( cMail, nPos, 1 ) == e"\t" );
.and. cLastField != NIL
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"
AAdd( ::aReceived, cValue )
ELSE
::hHeaders[ cLastField ] := cValue
ENDIF
ENDIF
nPos := nLinePos + 2
nLinePos := hb_At( e"\r\n", cMail, nPos )
//Prevents malformed body to affect us
IF cBoundary != NIL .and. hb_At( "--"+cBoundary, cMail, nPos ) == 1
RETURN 0
ENDIF
ENDDO
// now we may have a body or a multipart message; multipart
// messages may also have a "fake" body, that is usually not
// displayed, between their headers and the first multipart
// boundary.
IF "Content-Transfer-Encoding" $ ::hHeaders
::oEncoder := TIp_GetEncoder( ::hHeaders[ "Content-Transfer-Encoding" ] )
ENDIF
// se if we have subparts:
IF At( "multipart/", Lower( ::GetFieldPart("Content-Type")) ) > 0
cSubBoundary := ::GetFieldOption( "Content-Type", "Boundary" )
//strip " on boundary
IF Left( cSubBoundary, 1 ) == '"'
cSubBoundary := Substr( cSubBoundary, 2, Len( cSubBoundary ) - 2)
ENDIF
ENDIF
nPos := nLinePos + 2
nBodyPos := nPos
nLinePos := hb_At( e"\r\n", cMail, nPos )
DO WHILE nLinePos >= nPos
// Avoid useless tests for empty lines
IF nLinePos == nPos
nPos += 2
nLinePos := hb_At( e"\r\n", cMail, nPos )
LOOP
ENDIF
//have we met the boundary?
IF cBoundary != NIL .and. hb_At( "--"+cBoundary, cMail, nPos ) == nPos
EXIT
ENDIF
//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
EXIT
ENDIF
// set our body
IF nBodyPos > 0
::cBody := Substr( cMail, nBodyPos, nPos - nBodyPos )
nBodyPos := 0
ENDIF
// Add our subsection
oSubSection := TipMail():New()
nPos := oSubSection:FromString( cMail, cSubBoundary,;
nLinePos + 2 )
IF nPos > 0
AAdd( ::aAttachments, oSubSection )
ELSE
RETURN 0
ENDIF
// I must stay on the boundary found by the subsection to
// enter in this part of the loop again.
ELSE
//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 ))
ENDIF
nLinePos := hb_At( e"\r\n", cMail, nPos )
ENDDO
// set our body if needed
IF nBodyPos > 0
::cBody := Substr( cMail, nBodyPos, nPos - nBodyPos )
ENDIF
RETURN nPos
mail.prg 382 TIPMAIL:METHOD MakeBoundary() CLASS TipMail
METHOD MakeBoundary() CLASS TipMail
LOCAL cBound := "=_0" + Space(17)
LOCAL i
FOR i := 4 TO 20
cBound := Stuff( cBound, i, 1, Chr( HB_Random(0, 25 ) + Asc("A") ) )
NEXT
cBound += "_TIP_" + StrTran(Dtoc( Date() ),"/","") +;
"_" + StrTran(Time(), ":", "" )
RETURN cBound
mail.prg 519 TIPMAIL:METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
LOCAL aTo, aCC, aBCC, i, imax
IF !( Valtype( csubject ) == "C" )
cSubject := ""
ENDIF
IF !( Valtype( cFrom ) == "C" )
RETURN .F.
ENDIF
IF Valtype( cTo ) == "C"
aTo := { cTo }
ELSEIF Valtype( cTo ) == "A"
aTo := cTo
ENDIF
IF Valtype( cCC ) == "C"
aCC := { cCC }
ELSEIF Valtype( cCC ) == "A"
aCC := cCC
ENDIF
IF Valtype( cBCC ) == "C"
aBCC := { cBCC }
ELSEIF Valtype( cBCC ) == "A"
aBCC := cBCC
ENDIF
IF aTO == NIL
RETURN .F.
ENDIF
IF .NOT. ::setFieldPart( "Subject", cSubject )
RETURN .F.
ENDIF
IF .NOT. ::setFieldPart( "From" , cFrom )
RETURN .F.
ENDIF
cTo := aTO[1]
imax := Len( aTO )
FOR i:=2 TO imax
cTo += "," + HB_InetCrlf() + Chr(9) + aTo[i]
NEXT
IF .NOT. ::setFieldPart( "To", cTo )
RETURN .F.
ENDIF
IF aCC != NIL
cCC := aCC[1]
imax := Len( aCC )
FOR i:=2 TO imax
cCC += "," + HB_InetCrlf() + Chr(9) + aCC[i]
NEXT
IF .NOT. ::setFieldPart( "Cc", cCC )
RETURN .F.
ENDIF
ENDIF
IF aBCC != NIL
cBCC := aBCC[1]
imax := Len( aBCC )
FOR i:=2 TO imax
cBCC += "," + HB_InetCrlf() + Chr(9) + aBCC[i]
NEXT
IF .NOT. ::setFieldPart( "Bcc", cBCC )
RETURN .F.
ENDIF
ENDIF
RETURN .T.
mail.prg 534 TIPMAIL:METHOD attachFile( cFileName ) CLASS TipMail
METHOD attachFile( cFileName ) CLASS TipMail
LOCAL cContent := MemoRead( cFileName )
LOCAL cMimeType:= TIP_FileMimetype( cFileName )
LOCAL cDelim := HB_OsPathSeparator()
LOCAL oAttach
IF Empty( cContent )
RETURN .F.
ENDIF
oAttach := TIPMail():new( cContent, "base64" )
cFileName := SubStr( cFileName, Rat( cFileName, cDelim ) + 1 )
oAttach:setFieldPart ( "Content-Type", cMimeType )
oAttach:setFieldOption( "Content-Type", "name", cFileName )
oAttach:setFieldPart ( "Content-Disposition", "attachment" )
oAttach:setFieldOption( "Content-Disposition", "filename", cFileName )
RETURN ::attach( oAttach )
mail.prg 612 TIPMAIL:METHOD detachFile( cPath ) CLASS TipMail
METHOD detachFile( cPath ) CLASS TipMail
LOCAL cContent := ::getBody()
LOCAL cFileName := ::getFileName()
LOCAL cDelim := HB_OsPathSeparator()
LOCAL nFileHandle
IF Empty( cFileName )
RETURN .F.
ENDIF
IF Valtype( cPath ) == "C"
cFileName := StrTran( cPath + cDelim + cFileName, cDelim+cDelim, cDelim )
ENDIF
nFileHandle := FCreate( cFileName )
IF FError() != 0
RETURN .F.
ENDIF
FWrite( nFileHandle, cContent )
FClose( nFileHandle )
RETURN FError() == 0
mail.prg 635 TIPMAIL:METHOD getFileName() CLASS TipMail
METHOD getFileName() CLASS TipMail
RETURN StrTran( ::getFieldOption( "Content-Type", "name" ), '"', "" )
mail.prg 660 TIPMAIL:METHOD isMultiPart CLASS TipMail
METHOD isMultiPart CLASS TipMail
RETURN "multipart/" $ Lower( ::GetFieldPart("Content-Type") )
mail.prg 664 TIPMAIL:METHOD getMultiParts( aParts ) CLASS TipMail
METHOD getMultiParts( aParts ) CLASS TipMail
LOCAL oSubPart, lReset := .F.
::resetAttachment()
IF aParts == NIL
aParts := {}
ENDIF
DO WHILE ( oSubPart := ::nextAttachment() ) != NIL
lReset := .T.
AAdd( aParts, oSubPart )
IF oSubPart:countAttachments() > 0
oSubPart:getMultiparts( aParts )
ENDIF
ENDDO
IF lReset
::resetAttachment()
ENDIF
RETURN aParts
mail.prg 668 popcln.prg Type Function Source Line CLASS tIPClientPOP FROM tIPClient
CLASS tIPClientPOP FROM tIPClient
METHOD New( oUrl, lTrace, oCredentials )
METHOD Open()
METHOD Close()
METHOD Read( iLen )
METHOD Stat()
METHOD List()
METHOD Retrieve( nId, nLen )
METHOD Delete()
METHOD Quit()
METHOD Noop() // Can be called repeatedly to keep-alive the connection
METHOD Top( nMsgId ) // Get Headers of mail (no body) to be able to quickly handle a message
METHOD UIDL( nMsgId ) // Returns Unique ID of message n or list of unique IDs of all message inside maildrop
METHOD GetOK()
METHOD countMail()
METHOD retrieveAll()
ENDCLASS
popcln.prg 65 TIPCLIENTPOP:METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientPOP
METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientPOP
local cFile :="pop3"
local n := 0
::super:New( oUrl, lTrace, oCredentials )
::nDefaultPort := 110
::nConnTimeout := 10000
if ::ltrace
if !file("pop3.log")
::nHandle := fcreate("pop3.log")
else
while file(cFile+alltrim(str(n,2))+".log")
n++
enddo
::nHandle := fcreate(cFile+alltrim(str(n,2))+".log")
endif
endif
RETURN Self
popcln.prg 86 TIPCLIENTPOP:METHOD Open( cUrl ) CLASS tIPClientPOP
METHOD Open( cUrl ) CLASS tIPClientPOP
IF .not. ::super:Open( cUrl )
RETURN .F.
ENDIF
IF Empty ( ::oUrl:cUserid ) .or. Empty ( ::oUrl:cPassword )
RETURN .F.
ENDIF
HB_InetTimeout( ::SocketCon, ::nConnTimeout )
IF ::GetOk()
::InetSendall( ::SocketCon, "USER " + ::oUrl:cUserid + ::cCRLF )
IF ::GetOK()
::InetSendall( ::SocketCon, "PASS " + ::oUrl:cPassword + ::cCRLF )
IF ::GetOK()
::isOpen := .T.
RETURN .T.
ENDIF
ENDIF
ENDIF
RETURN .F.
popcln.prg 109 TIPCLIENTPOP:METHOD GetOk() CLASS tIPClientPOP
METHOD GetOk() CLASS tIPClientPOP
LOCAL nLen
::cReply := ::InetRecvLine( ::SocketCon, @nLen, 128 )
IF ::InetErrorCode( ::SocketCon ) != 0 .or. !( SubStr( ::cReply, 1, 1 ) == "+" )
RETURN .F.
ENDIF
RETURN .T.
popcln.prg 132 TIPCLIENTPOP:METHOD Noop() CLASS tIPClientPOP
METHOD Noop() CLASS tIPClientPOP
::InetSendall( ::SocketCon, "NOOP" + ::cCRLF )
RETURN ::GetOk()
popcln.prg 142 TIPCLIENTPOP:METHOD Close() CLASS tIPClientPOP
METHOD Close() CLASS tIPClientPOP
HB_InetTimeOut( ::SocketCon, ::nConnTimeout )
if ::ltrace
fClose(::nHandle)
endif
::Quit()
RETURN ::super:Close()
popcln.prg 147 TIPCLIENTPOP:METHOD Quit() CLASS tIPClientPOP
METHOD Quit() CLASS tIPClientPOP
::InetSendall( ::SocketCon, "QUIT" + ::cCRLF )
RETURN ::GetOk()
popcln.prg 157 TIPCLIENTPOP:METHOD Stat() CLASS tIPClientPOP
METHOD Stat() CLASS tIPClientPOP
LOCAL nRead
::InetSendall( ::SocketCon, "STAT" + ::cCRLF )
RETURN ::InetRecvLine( ::SocketCon, @nRead, 128)
popcln.prg 162 TIPCLIENTPOP:METHOD Read( nLen ) CLASS tIPClientPOP
METHOD Read( nLen ) CLASS tIPClientPOP
/** Set what to read for */
IF Empty( ::oUrl:cFile )
RETURN ::List()
ENDIF
IF Val (::oUrl:cFile ) < 0
IF ::Delete( - Val (::oUrl:cFile ) )
RETURN ::Quit()
ELSE
RETURN .F.
ENDIF
ENDIF
RETURN ::Retrieve( Val (::oUrl:cFile ), nLen )
popcln.prg 168 TIPCLIENTPOP:METHOD Top( nMsgId ) CLASS tIPClientPOP
METHOD Top( nMsgId ) CLASS tIPClientPOP
LOCAL nPos
LOCAL cStr, cRet
::InetSendall( ::SocketCon, "TOP " + Str( nMsgId ) + " 0 " + ::cCRLF )
IF .not. ::GetOk()
RETURN NIL
ENDIF
cRet := ""
DO WHILE !( cStr == "." ) .and. ::InetErrorCode( ::SocketCon ) == 0
cStr := ::InetRecvLine( ::SocketCon, @nPos, 256 )
IF !( cStr == "." )
cRet += cStr + ::cCRLF
ELSE
::bEof := .T.
ENDIF
ENDDO
IF ::InetErrorCode( ::SocketCon ) != 0
RETURN NIL
ENDIF
RETURN cRet
popcln.prg 186 TIPCLIENTPOP:METHOD List() CLASS tIPClientPOP
METHOD List() CLASS tIPClientPOP
LOCAL nPos
LOCAL cStr, cRet
::InetSendall( ::SocketCon, "LIST" + ::cCRLF )
IF .not. ::GetOk()
RETURN NIL
ENDIF
cRet := ""
DO WHILE !( cStr == "." ) .and. ::InetErrorCode( ::SocketCon ) == 0
cStr := ::InetRecvLine( ::SocketCon, @nPos, 256 )
IF !( cStr == "." )
cRet += cStr + ::cCRLF
ELSE
::bEof := .T.
ENDIF
ENDDO
IF ::InetErrorCode( ::SocketCon ) != 0
RETURN NIL
ENDIF
RETURN cRet
popcln.prg 214 TIPCLIENTPOP:METHOD UIDL( nMsgId ) CLASS tIPClientPOP
METHOD UIDL( nMsgId ) CLASS tIPClientPOP
LOCAL nPos
LOCAL cStr, cRet
IF ! Empty( nMsgId )
::InetSendall( ::SocketCon, "UIDL " + Str( nMsgId ) + ::cCRLF )
ELSE
::InetSendall( ::SocketCon, "UIDL" + ::cCRLF )
ENDIF
IF .not. ::GetOk()
RETURN NIL
ENDIF
IF ! Empty( nMsgId )
// +OK Space(1) nMsg Space(1) UID
RETURN SubStr(::cReply, Rat(Space(1), ::cReply) + 1)
ELSE
cRet := ""
DO WHILE !( cStr == "." ) .and. ::InetErrorCode( ::SocketCon ) == 0
cStr := ::InetRecvLine( ::SocketCon, @nPos, 256 )
IF !( cStr == "." )
cRet += cStr + ::cCRLF
ELSE
::bEof := .T.
ENDIF
ENDDO
ENDIF
IF ::InetErrorCode( ::SocketCon ) != 0
RETURN NIL
ENDIF
RETURN cRet
popcln.prg 242 TIPCLIENTPOP:METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP
METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP
LOCAL nPos
LOCAL cRet, nRetLen, cBuffer, nRead
LOCAL cEOM := ::cCRLF + "." + ::cCRLF // End Of Mail
IF .not. ::bInitialized
::InetSendall( ::SocketCon, "RETR "+ Str( nId ) + ::cCRLF )
IF .not. ::GetOk()
::bEof := .T.
RETURN NIL
ENDIF
::bInitialized := .T.
ENDIF
cRet := ""
nRetLen := 0
nRead := 0
/* 04/05/2004 -
Instead of receiving a single char at a time until after we have the full mail, let's receive as
much as we can and stop when we reach EOM (end of mail :)) sequence. This way is _a lot_ faster
*/
DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .AND. ! ::bEof
cBuffer := Space(1024)
nRead := ::InetRecv( ::SocketCon, @cBuffer, 1024 )
cRet += Left( cBuffer, nRead )
/* 24/11/2005 -
"- Len( cEOM )" to be sure to always find a full EOM,
otherwise if response breaks EOM in two, it will never
be found
*/
IF ( nPos := hb_At( cEOM, cRet, Max( nRetLen - Len( cEOM ), 1 ) ) ) != 0
// Remove ".CRLF"
cRet := Left( cRet, nPos + 1 )
::bEof := .T.
ELSEIF ! Empty( nLen ) .AND. nLen < Len( cRet )
EXIT
ELSE
nRetLen += nRead
ENDIF
ENDDO
IF ::InetErrorCode( ::SocketCon ) != 0
RETURN NIL
ENDIF
// Remove byte-stuffed termination octet(s) if any
RETURN StrTran( cRet, ::cCRLF + "..", ::cCRLF + "." )
popcln.prg 285 TIPCLIENTPOP:METHOD Delete( nId ) CLASS tIPClientPOP
METHOD Delete( nId ) CLASS tIPClientPOP
::InetSendall( ::SocketCon, "DELE " + AllTrim( Str( nId ) ) + ::cCRLF )
RETURN ::GetOk()
popcln.prg 345 TIPCLIENTPOP:METHOD countMail CLASS TIpClientPop
METHOD countMail CLASS TIpClientPop
LOCAL aMails
IF ::isOpen
::reset()
aMails := HB_ATokens( StrTran( ::list(), Chr(13),""), Chr(10) )
RETURN Len( aMails )
ENDIF
RETURN -1
popcln.prg 351 TIPCLIENTPOP:METHOD retrieveAll( lDelete )
METHOD retrieveAll( lDelete )
LOCAL aMails, i, imax, cMail
IF !( Valtype( lDelete ) == "L" )
lDelete := .F.
ENDIF
IF .NOT. ::isOpen
RETURN NIL
ENDIF
imax := ::countMail()
aMails := Array( imax )
FOR i:=1 TO imax
::reset()
cMail := ::retrieve( i )
aMails[i] := TIpMail():new()
aMails[i]:fromString( cMail )
IF lDelete
::reset()
::delete(i)
ENDIF
NEXT
RETURN aMails
popcln.prg 361 sendmail.prg Type Function Source Line 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
cFrom -> Required. Email address of the sender
aTo -> Required. Character string or array of email addresses to send the email to
aCC -> Optional. Character string or array of email adresses for CC (Carbon Copy)
aBCC -> 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.
lTrace -> Optional. If set to .T., a log file is created (sendmail.log). Standard setting is .F.
lNoAuth -> Optional. Disable Autentication methods
nTimeOut -> Optional. Number os ms to wait default 20000 (20s)
cReplyTo -> Optional.
*/
LOCAL oInMail, cBodyTemp, oUrl, oMail, oAttach, aThisFile, cFile, cFname, cFext, cData, oUrl1
LOCAL cTmp :=""
LOCAL cMimeText := ""
LOCAL cTo := ""
LOCAL cCC := ""
LOCAL cBCC := ""
LOCAL lConnectPlain := .F.
LOCAL lReturn := .T.
LOCAL lAuthLogin := .F.
LOCAL lAuthPlain := .F.
LOCAL lConnect := .T.
LOCAL oPop
DEFAULT cUser TO ""
DEFAULT cPass TO ""
DEFAULT nPort TO 25
DEFAULT aFiles TO {}
DEFAULT nPriority TO 3
DEFAULT lRead TO .F.
DEFAULT lTrace TO .F.
DEFAULT lPopAuth TO .T.
DEFAULT lNoAuth TO .F.
DEFAULT nTimeOut TO 100
DEFAULT cReplyTo TO ""
cUser := StrTran( cUser, "@", "&at;" )
IF !( (".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. File(cBody) )
IF !( Right( cBody, 2 ) == HB_OSNewLine() )
cBody += HB_OsNewLine()
ENDIF
ENDIF
// cTo
IF Valtype( aTo ) == "A"
IF Len( aTo ) > 1
FOR EACH cTo IN aTo
IF cTo:__enumIndex() != 1
cTmp += cTo + ","
ENDIF
NEXT
cTmp := Substr( cTmp, 1, Len( cTmp ) - 1 )
ENDIF
cTo := aTo[ 1 ]
IF Len( cTmp ) > 0
cTo += "," + cTmp
ENDIF
ELSE
cTo := Alltrim( aTo )
ENDIF
// CC (Carbon Copy)
IF Valtype(aCC) =="A"
IF Len(aCC) >0
FOR EACH cTmp IN aCC
cCC += cTmp + ","
NEXT
cCC := Substr( cCC, 1, Len( cCC ) - 1 )
ENDIF
ELSEIF Valtype(aCC) =="C"
cCC := Alltrim( aCC )
ENDIF
// BCC (Blind Carbon Copy)
IF Valtype(aBCC) =="A"
IF Len(aBCC)>0
FOR EACH cTmp IN aBCC
cBCC += cTmp + ","
NEXT
cBCC := Substr( cBCC, 1, Len( cBCC ) - 1 )
ENDIF
ELSEIF Valtype(aBCC) =="C"
cBCC := Alltrim( aBCC )
ENDIF
IF cPopServer != NIL .AND. lPopAuth
BEGIN SEQUENCE
oUrl1 := tUrl():New( "pop://" + cUser + ":" + cPass + "@" + cPopServer + "/" )
oUrl1:cUserid := Strtran( cUser, "&at;", "@" )
opop:= tIPClientPOP():New( oUrl1, lTrace )
IF oPop:Open()
oPop:Close()
ENDIF
RECOVER
lReturn := .F.
END
ENDIF
IF !lReturn
RETURN .F.
ENDIF
BEGIN SEQUENCE
oUrl := tUrl():New( "smtp://" + cUser + "@" + cServer + "/" + cTo )
RECOVER
lReturn := .F.
END
IF !lReturn
RETURN .F.
ENDIF
oUrl:nPort := nPort
oUrl:cUserid := Strtran( cUser, "&at;", "@" )
oMail := tipMail():new()
oAttach := tipMail():new()
oAttach:SetEncoder( "7-bit" )
IF (".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. File(cBody)
cMimeText := "text/html ; charset=ISO-8859-1"
oAttach:hHeaders[ "Content-Type" ] := cMimeText
cBodyTemp := cBody
cBody := MemoRead( cBodyTemp ) + chr( 13 ) + chr( 10 )
ELSE
oMail:hHeaders[ "Content-Type" ] := "text/plain; charset=iso8851"
ENDIF
oAttach:SetBody( cBody )
oMail:Attach( oAttach )
oUrl:cFile := cTo + iif( Empty(cCC), "", "," + cCC ) + iif( Empty(cBCC), "", "," + cBCC)
oMail:hHeaders[ "Date" ] := tip_Timestamp()
oMail:hHeaders[ "From" ] := cFrom
IF !Empty(cCC)
oMail:hHeaders[ "Cc" ] := cCC
ENDIF
IF !Empty(cBCC)
oMail:hHeaders[ "Bcc" ] := cBCC
ENDIF
IF !Empty(cReplyTo)
oMail:hHeaders[ "Reply-To" ] := cReplyTo
ENDIF
BEGIN SEQUENCE
oInmail := tIPClientSMTP():New( oUrl, lTrace)
RECOVER
lReturn := .F.
END
IF !lReturn
RETURN .F.
ENDIF
oInmail:nConnTimeout:= nTimeOut
IF !lNoAuth
IF oInMail:Opensecure()
WHILE .T.
oInMail:GetOk()
IF oInMail:cReply == NIL
EXIT
ELSEIF "LOGIN" $ oInMail:cReply
lAuthLogin := .T.
ELSEIF "PLAIN" $ oInMail:cReply
lAuthPlain := .T.
ENDIF
ENDDO
IF lAuthLogin
IF !oInMail:Auth( cUser, cPass )
lConnect := .F.
ELSE
lConnectPlain := .T.
ENDIF
ENDIF
IF lAuthPlain .AND. !lConnect
IF !oInMail:AuthPlain( cUser, cPass )
lConnect := .F.
ENDIF
ELSE
IF !lConnectPlain
oInmail:Getok()
lConnect := .F.
ENDIF
ENDIF
ELSE
lConnect := .F.
ENDIF
ELSE
lConnect := .F.
ENDIF
IF !lConnect
if !lNoAuth
oInMail:Close()
endif
BEGIN SEQUENCE
oInmail := tIPClientsmtp():New( oUrl, lTrace)
RECOVER
lReturn := .F.
END
oInmail:nConnTimeout:=nTimeOut
IF !oInMail:Open()
lConnect := .F.
oInmail:Close()
RETURN .F.
ENDIF
WHILE .T.
oInMail:GetOk()
IF oInMail:cReply == NIL
EXIT
ENDIF
ENDDO
ENDIF
oInMail:oUrl:cUserid := cFrom
oMail:hHeaders[ "To" ] := cTo
oMail:hHeaders[ "Subject" ] := cSubject
FOR EACH aThisFile IN AFiles
IF Valtype( aThisFile ) == "C"
cFile := aThisFile
cData := Memoread( cFile ) + chr( 13 ) + chr( 10 )
ELSEIF Valtype( aThisFile ) == "A" .AND. Len( aThisFile ) >= 2
cFile := aThisFile[ 1 ]
cData := aThisFile[ 2 ] + chr( 13 ) + chr( 10 )
ELSE
lReturn := .F.
EXIT
ENDIF
oAttach := TipMail():New()
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)" ) .OR. Empty(cFExt)
oAttach:SetEncoder( "base64" )
ELSE
oAttach:SetEncoder( "7-bit" )
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=ISO-8859-1"
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" ] := cFrom
ENDIF
IF nPriority != 3
oMail:hHeaders[ "X-Priority" ] := Str( nPriority, 1 )
ENDIF
oInmail:Write( oMail:ToString() )
oInMail:Commit()
oInMail:Close()
RETURN lReturn
sendmail.prg 59 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
RETURN "text/plain;filename=" + cFname + cFext
sendmail.prg 392 sessid.prg Type Function Source Line FUNCTION TIP_GENERATESID( cCRCKey )
FUNCTION TIP_GENERATESID( cCRCKey )
local cSID, nSIDCRC, cSIDCRC, n, cTemp
local nLenSID := SID_LENGTH
local cBaseKeys := BASE_KEY_STRING
local nLenKeys := Len( cBaseKeys )
local cRet
local nRand, nKey := 0
DEFAULT cCRCKey TO CRC_KEY_STRING
cCRCKey := Left( cCRCKey, 10 ) // Max Lenght must to be of 10 chars
/* Let's generate the sequence */
cSID := Space( nLenSID )
for n := 1 TO nLenSID
nRand := HB_RandomInt( 1, nLenKeys )
cSID := Stuff( cSID, n, 1, SubStr( cBaseKeys, nRand, 1 ) )
nKey += nRand
next
nSIDCRC := nKey * 51 // Max Value is 99603 a 5 chars number
cTemp := StrZero( nSIDCRC, 5 )
cSIDCRC := ""
for n := 1 to Len( cTemp )
cSIDCRC += SubStr( cCRCKey, Val( SubStr( cTemp, n, 1 ) ) + 1, 1 )
next
cRet := cSID + cSIDCRC
RETURN cRet
sessid.prg 71 FUNCTION TIP_CHECKSID( cSID, cCRCKey )
FUNCTION TIP_CHECKSID( cSID, cCRCKey )
local nSIDCRC, cSIDCRC, n, cTemp
local nLenSID := SID_LENGTH
local cBaseKeys := BASE_KEY_STRING
local nLenKeys := Len( cBaseKeys )
local nRand, nKey := 0
DEFAULT cCRCKey TO CRC_KEY_STRING
cCRCKey := Left( cCRCKey, 10 ) // Max Lenght must to be of 10 chars
/* Calculate the key */
for n := 1 to nLenSID
nRand := At( SubStr( cSID, n, 1), cBaseKeys )
nKey += nRand
next
// Recalculate the CRC
nSIDCRC := nKey * 51 // Max Value is 99603. a 5 chars number
cTemp := StrZero( nSIDCRC, 5 )
cSIDCRC := ""
for n := 1 to Len( cTemp )
cSIDCRC += SubStr( cCRCKey, Val( SubStr( cTemp, n, 1 ) ) + 1, 1 )
next
RETURN Right( cSID, 5 ) == cSIDCRC
sessid.prg 103 FUNCTION TIP_DATETOGMT( dDate, cTime )
FUNCTION TIP_DATETOGMT( dDate, cTime )
LOCAL cStr := ""
LOCAL cOldDateFormat := Set( _SET_DATEFORMAT, "dd-mm-yy" )
LOCAL nDay, nMonth, nYear, nDoW
LOCAL aDays := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }
LOCAL aMonths := { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }
DEFAULT dDate TO DATE()
DEFAULT cTime TO TIME()
nDay := Day( dDate )
nMonth := Month( dDate )
nYear := Year( dDate)
nDoW := Dow( dDate )
cStr := aDays[ nDow ] + ", " + StrZero( nDay, 2 ) + "-" + aMonths[ nMonth ] + "-" + ;
Right( StrZero( nYear, 4 ), 2 ) + " " + cTime + " GMT"
Set( _SET_DATEFORMAT, cOldDateFormat )
RETURN cStr
sessid.prg 131 smtpcln.prg Type Function Source Line CLASS tIPClientSMTP FROM tIPClient
CLASS tIPClientSMTP FROM tIPClient
METHOD New( oUrl, lTrace, oCredentials )
METHOD Open()
METHOD Close()
METHOD Write( cData, nLen, bCommit )
METHOD Mail( cFrom )
METHOD Rcpt( cRcpt )
METHOD Data( cData )
METHOD Commit()
METHOD Quit()
METHOD GetOK()
/* Method 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
HIDDEN:
DATA isAuth INIT .F.
ENDCLASS
smtpcln.prg 65 TIPCLIENTSMTP:METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientSMTP
METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientSMTP
local cFile :="sendmail"
local n:=1
::super:New( oUrl, lTrace, oCredentials )
::nDefaultPort := 25
::nConnTimeout := 5000
::nAccessMode := TIP_WO // a write only
if ::ltrace
if !file("sendmail.log")
::nHandle := fcreate("sendmail.log")
else
while file(cFile+alltrim(str(n,4))+".log")
n++
enddo
::nHandle := fcreate(cFile+alltrim(str(n,4))+".log")
endif
endif
RETURN Self
smtpcln.prg 88 TIPCLIENTSMTP:METHOD Open( cUrl ) CLASS tIPClientSMTP
METHOD Open( cUrl ) CLASS tIPClientSMTP
IF .not. ::super:Open( cUrl )
RETURN .F.
ENDIF
HB_InetTimeout( ::SocketCon, ::nConnTimeout )
IF .not. Empty ( ::oUrl:cUserid )
::InetSendall( ::SocketCon, "HELO " + ::oUrl:cUserid + ::cCRLF )
ELSE
::InetSendall( ::SocketCon, "HELO tipClientSMTP" + ::cCRLF )
ENDIF
RETURN ::GetOk()
smtpcln.prg 109 TIPCLIENTSMTP:METHOD GetOk() CLASS tIPClientSMTP
METHOD GetOk() CLASS tIPClientSMTP
LOCAL nLen
::cReply := ::InetRecvLine( ::SocketCon, @nLen, 512 )
IF ::InetErrorCode( ::SocketCon ) != 0 .or. Substr( ::cReply, 1, 1 ) == "5"
RETURN .F.
ENDIF
RETURN .T.
smtpcln.prg 125 TIPCLIENTSMTP:METHOD Close() CLASS tIPClientSMTP
METHOD Close() CLASS tIPClientSMTP
HB_InetTimeOut( ::SocketCon, ::nConnTimeout )
if ::ltrace
fClose(::nHandle)
endif
::Quit()
RETURN ::super:Close()
smtpcln.prg 135 TIPCLIENTSMTP:METHOD Commit() CLASS tIPClientSMTP
METHOD Commit() CLASS tIPClientSMTP
::InetSendall( ::SocketCon, ::cCRLF + "." + ::cCRLF )
RETURN ::GetOk()
smtpcln.prg 143 TIPCLIENTSMTP:METHOD Quit() CLASS tIPClientSMTP
METHOD Quit() CLASS tIPClientSMTP
::InetSendall( ::SocketCon, "QUIT" + ::cCRLF )
::isAuth := .F.
RETURN ::GetOk()
smtpcln.prg 148 TIPCLIENTSMTP:METHOD Mail( cFrom ) CLASS tIPClientSMTP
METHOD Mail( cFrom ) CLASS tIPClientSMTP
::InetSendall( ::SocketCon, "MAIL FROM: <" + cFrom +">" + ::cCRLF )
RETURN ::GetOk()
smtpcln.prg 154 TIPCLIENTSMTP:METHOD Rcpt( cTo ) CLASS tIPClientSMTP
METHOD Rcpt( cTo ) CLASS tIPClientSMTP
::InetSendall( ::SocketCon, "RCPT TO: <" + cTo + ">" + ::cCRLF )
RETURN ::GetOk()
smtpcln.prg 159 TIPCLIENTSMTP:METHOD Data( cData ) CLASS tIPClientSMTP
METHOD Data( cData ) CLASS tIPClientSMTP
::InetSendall( ::SocketCon, "DATA" + ::cCRLF )
IF .not. ::GetOk()
RETURN .F.
ENDIF
::InetSendall(::SocketCon, cData + ::cCRLF + "." + ::cCRLF )
RETURN ::GetOk()
smtpcln.prg 164 TIPCLIENTSMTP:METHOD OpenSecure( cUrl ) CLASS tIPClientSMTP
METHOD OpenSecure( cUrl ) CLASS tIPClientSMTP
Local cUser
IF .not. ::super:Open( cUrl )
RETURN .F.
ENDIF
HB_InetTimeout( ::SocketCon, ::nConnTimeout )
cUser := ::oUrl:cUserid
IF .not. Empty ( ::oUrl:cUserid )
::InetSendall( ::SocketCon, "EHLO " + cUser + ::cCRLF )
ELSE
::InetSendall( ::SocketCon, "EHLO tipClientSMTP" + ::cCRLF )
ENDIF
RETURN ::getOk()
smtpcln.prg 174 TIPCLIENTSMTP:METHOD AUTH( cUser, cPass) CLASS tIPClientSMTP
METHOD AUTH( cUser, cPass) CLASS tIPClientSMTP
Local cs:=""
Local cEncodedUser
Local cEncodedPAss
cUser := StrTran( cUser,"&at;", "@")
cEncodedUser := alltrim(HB_BASE64(cuser,len(cuser)))
cEncodedPAss := alltrim(HB_BASE64(cPass,len(cpass)))
::InetSendall( ::SocketCon, "AUTH LOGIN" +::ccrlf )
if ::GetOk()
::InetSendall( ::SocketCon, cEncodedUser+::cCrlf )
if ::Getok()
::InetSendall( ::SocketCon, cEncodedPass +::cCrlf )
endif
endif
return ::isAuth := ::GetOk()
smtpcln.prg 194 TIPCLIENTSMTP:METHOD AuthPlain( cUser, cPass) CLASS tIPClientSMTP
METHOD AuthPlain( cUser, cPass) CLASS tIPClientSMTP
Local cBase := BUILDUSERPASSSTRING( cUser, cPass )
Local cen := HB_BASE64( cBase, 2 + Len( cUser ) + Len( cPass ) )
::InetSendall( ::SocketCon, "AUTH PLAIN" + cen + ::cCrlf)
return ::isAuth := ::GetOk()
smtpcln.prg 217 TIPCLIENTSMTP:METHOD Write( cData, nLen, bCommit ) CLASS tIPClientSMTP
METHOD Write( cData, nLen, bCommit ) CLASS tIPClientSMTP
Local aTo,cRecpt
IF .not. ::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
IF .not. ::Mail( ::oUrl:cUserid )
RETURN -1
ENDIF
aTo:= HB_RegexSplit(",", ::oUrl:cFile )
FOR each cRecpt in Ato
IF .not. ::Rcpt(cRecpt)
RETURN -1
ENDIF
NEXT
::InetSendall( ::SocketCon, "DATA" + ::cCRLF )
IF .not. ::GetOk()
RETURN -1
ENDIF
::bInitialized := .T.
ENDIF
::nLastWrite := ::super:Write( cData, nLen, bCommit )
RETURN ::nLastWrite
smtpcln.prg 226 TIPCLIENTSMTP:METHOD ServerSuportSecure(lAuthp,lAuthl) CLASS tIPClientSMTP
METHOD ServerSuportSecure(lAuthp,lAuthl) CLASS tIPClientSMTP
Local lAuthLogin := .F.,lAuthPlain :=.F.
IF ::OPENSECURE()
WHILE .T.
::GetOk()
IF ::cReply == NIL
EXIT
ELSEIF "LOGIN" $ ::cReply
lAuthLogin := .T.
ELSEIF "PLAIN" $ ::cReply
lAuthPlain := .T.
ENDIF
ENDDO
::CLOSE()
ENDIF
lAuthp:=lAuthPlain
lAuthl:=lAuthLogin
RETURN lAuthLogin .OR. lAuthPlain
smtpcln.prg 255 TIPCLIENTSMTP:METHOD sendMail( oTIpMail ) CLASS TIpClientSmtp
METHOD sendMail( oTIpMail ) CLASS TIpClientSmtp
LOCAL cFrom, cTo, aTo
IF .NOT. ::isOpen
RETURN .F.
ENDIF
IF .NOT. ::isAuth
::auth( ::oUrl:cUserId, ::oUrl:cPassWord )
IF .NOT. ::isAuth
RETURN .F.
ENDIF
ENDIF
cFrom := oTIpMail:getFieldPart( "From" )
cTo := oTIpMail:getFieldPart( "To" )
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
::rcpt( cTo )
NEXT
RETURN ::data( oTIpMail:toString() )
smtpcln.prg 278 thtml.prg Type Function Source Line CLASS THtmlDocument MODULE FRIENDLY
CLASS THtmlDocument MODULE FRIENDLY
HIDDEN:
DATA oIterator
DATA nodes
EXPORTED:
DATA root READONLY
DATA head READONLY
DATA body READONLY
DATA changed INIT .T.
METHOD new( cHtmlString )
METHOD readFile( cFileName )
METHOD writeFile( cFileName )
METHOD collect()
METHOD toString( nIndent )
METHOD getNode( cTagName )
METHOD getNodes( cTagName )
METHOD findFirst( cName, cAttrib, cValue, cData )
METHOD findFirstRegex( cName, cAttrib, cValue, cData )
thtml.prg 109 THTMLDOCUMENT:METHOD findNext()
METHOD findNext() INLINE ::oIterator:Next()
ENDCLASS
thtml.prg 130 THTMLDOCUMENT:METHOD new( cHtmlString ) CLASS THtmlDocument
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() +;
''
IF !( Valtype( cHtmlString ) == "C" )
::root := THtmlNode():new( cEmptyHtmlDoc )
ELSE
IF .NOT. ", and tags
// Although they are optional, the THtmlDocument class enforces them
// so that the instance variables :head and :body are always available
aHead := {}
aBody := {}
FOR EACH oSubNode IN ::root:htmlContent
IF oSubNode:isType( CM_HEAD )
AAdd( aHead, oSubNode )
ELSE
AAdd( aBody, oSubNode )
ENDIF
NEXT
::root := THtmlNode():new( cEmptyHtmlDoc )
::root:document := self
::changed := .T.
::head := ::getNode( "head" )
::body := ::getNode( "body" )
FOR EACH oSubNode IN aHead
IF oSubNode:isType( CM_HEAD )
::head:addNode( oSubNode )
ELSE
::body:addNode( oSubNode )
ENDIF
NEXT
FOR EACH oSubNode IN aBody
IF Lower( oSubNode:htmlTagName ) $ "html,head,body"
// This node is an error in the HTML string.
// We gracefully add its subnodes to the tag
FOR EACH oErrNode IN oSubNode:htmlContent
::body:addNode( oErrNode )
NEXT
ELSE
IF oSubNode:isType( CM_HEAD )
oSubNode:delete()
::head:addNode( oSubNode )
ELSE
::body:addNode( oSubNode )
ENDIF
ENDIF
NEXT
ELSEIF ::head == NIL
::head := ::body:insertBefore( THtmlNode():new( ::body, "head" ) )
ELSEIF ::body == NIL
::head := ::head:insertAfter( THtmlNode():new( ::head, "body" ) )
ENDIF
IF nMode == 1
oNode := THtmlNode():new( cHtmlString )
FOR EACH oSubNode IN oNode:htmlContent
IF oSubNode:isType( CM_HEAD )
::head:addNode( oSubNode )
ELSE
::body:addNode( oSubNode )
ENDIF
NEXT
ENDIF
RETURN self
thtml.prg 135 THTMLDOCUMENT:METHOD toString() CLASS THtmlDocument
METHOD toString() CLASS THtmlDocument
RETURN ::root:toString()
thtml.prg 229 THTMLDOCUMENT:METHOD readFile( cFileName ) CLASS THtmlDocument
METHOD readFile( cFileName ) CLASS THtmlDocument
IF ! File( cFileName )
RETURN .F.
ENDIF
::changed := .T.
::new( Memoread( cFileName ) )
RETURN .T.
thtml.prg 234 THTMLDOCUMENT:METHOD writeFile( cFileName ) CLASS THtmlDocument
METHOD writeFile( cFileName ) CLASS THtmlDocument
LOCAL cHtml := ::toString()
LOCAL nFileHandle := FCreate( cFileName )
IF FError() != 0
RETURN .F.
ENDIF
FWrite( nFileHandle, cHtml, Len(cHtml) )
FClose( nFileHandle )
::changed := .F.
RETURN FError() == 0
thtml.prg 244 THTMLDOCUMENT:METHOD collect() CLASS THtmlDocument
METHOD collect() CLASS THtmlDocument
IF ::changed
::nodes := ::root:collect()
::changed := .F.
ENDIF
RETURN ::nodes
thtml.prg 259 THTMLDOCUMENT:METHOD getNode( cTagName ) CLASS THtmlDocument
METHOD getNode( cTagName ) CLASS THtmlDocument
LOCAL oNode
IF ::changed
::collect()
ENDIF
FOR EACH oNode IN ::nodes
IF Lower( oNode:htmlTagName ) == Lower( cTagName )
RETURN oNode
ENDIF
NEXT
RETURN NIL
thtml.prg 268 THTMLDOCUMENT:METHOD getNodes( cTagName ) CLASS THtmlDocument
METHOD getNodes( cTagName ) CLASS THtmlDocument
LOCAL oNode, stack := S_STACK()
IF ::changed
::collect()
ENDIF
FOR EACH oNode IN ::nodes
IF Lower( oNode:htmlTagName ) == Lower( cTagName )
S_PUSH( stack, oNode )
ENDIF
NEXT
S_COMPRESS( stack )
RETURN stack[S_DATA]
thtml.prg 284 THTMLDOCUMENT:METHOD findFirst( cName, cAttrib, cValue, cData ) CLASS THtmlDocument
METHOD findFirst( cName, cAttrib, cValue, cData ) CLASS THtmlDocument
::oIterator := THtmlIteratorScan():New( self )
RETURN ::oIterator:Find( cName, cAttrib, cValue, cData )
thtml.prg 302 THTMLDOCUMENT:METHOD findFirstRegex( cName, cAttrib, cValue, cData ) CLASS THtmlDocument
METHOD findFirstRegex( cName, cAttrib, cValue, cData ) CLASS THtmlDocument
::oIterator := THtmlIteratorRegex():New( self )
RETURN ::oIterator:Find( cName, cAttrib, cValue, cData )
thtml.prg 308 CLASS THtmlIterator MODULE FRIENDLY
CLASS THtmlIterator MODULE FRIENDLY
METHOD New( oNodeTop ) CONSTRUCTOR
METHOD Next()
METHOD Rewind()
METHOD Find( cName, cAttribute, cValue, cData )
thtml.prg 318 THTMLITERATOR:METHOD GetNode()
METHOD GetNode() INLINE ::oNode
METHOD SetContext()
METHOD Clone()
HIDDEN:
DATA cName
DATA cAttribute
DATA cValue
DATA cData
DATA oNode
DATA oTop
DATA aNodes
DATA nCurrent
DATA nLast
METHOD MatchCriteria()
ENDCLASS
thtml.prg 324 THTMLITERATOR:METHOD New( oHtml ) CLASS THtmlIterator
METHOD New( oHtml ) CLASS THtmlIterator
IF oHtml:isDerivedFrom ( "THtmlDocument" )
::oNode := oHtml:root
::aNodes:= oHtml:nodes
ELSE
::oNode := oHtml
::aNodes := ::oNode:collect()
ENDIF
::oTop := ::oNode
::nCurrent := 1
::nLast := Len( ::aNodes )
RETURN Self
thtml.prg 342 THTMLITERATOR:METHOD rewind CLASS THtmlIterator
METHOD rewind CLASS THtmlIterator
::oNode := ::oTop
::nCurrent := 0
RETURN self
thtml.prg 357 THTMLITERATOR:METHOD Clone() CLASS THtmlIterator
METHOD Clone() CLASS THtmlIterator
LOCAL oRet
oRet := THtmlIterator():New( ::oTop )
oRet:cName := ::cName
oRet:cAttribute := ::cAttribute
oRet:cValue := ::cValue
oRet:cData := ::cData
oRet:nCurrent := 0
oRet:nLast := Len( ::aNodes )
oRet:aNodes := ::aNodes
RETURN oRet
thtml.prg 363 THTMLITERATOR:METHOD SetContext() CLASS THtmlIterator
METHOD SetContext() CLASS THtmlIterator
::oTop := ::oNode
::aNodes := ::oNode:collect()
::nCurrent := 0
::nLast := Len( ::aNodes )
RETURN Self
thtml.prg 378 THTMLITERATOR:METHOD Find( cName, cAttribute, cValue, cData ) CLASS THtmlIterator
METHOD Find( cName, cAttribute, cValue, cData ) CLASS THtmlIterator
::cName := cName
::cAttribute := cAttribute
::cValue := cValue
::cData := cData
IF ::nLast == 0
::nCurrent := 0
RETURN NIL
ENDIF
IF ::MatchCriteria( ::oNode )
RETURN ::oNode
ENDIF
RETURN ::Next()
thtml.prg 386 THTMLITERATOR:METHOD Next() CLASS THtmlIterator
METHOD Next() CLASS THtmlIterator
LOCAL oFound, lExit := .F.
DO WHILE .NOT. lExit
BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
oFound := ::aNodes[ ++::nCurrent ]
IF ::MatchCriteria( oFound )
::oNode := oFound
lExit := .T.
ENDIF
RECOVER
lExit := .T.
oFound := NIL
::nCurrent := 0
END
ENDDO
RETURN oFound
thtml.prg 403 THTMLITERATOR:METHOD MatchCriteria() CLASS THtmlIterator
METHOD MatchCriteria() CLASS THtmlIterator
RETURN .T.
thtml.prg 422 CLASS THtmlIteratorScan FROM THtmlIterator MODULE FRIENDLY
CLASS THtmlIteratorScan FROM THtmlIterator MODULE FRIENDLY
METHOD New( oNodeTop ) CONSTRUCTOR
HIDDEN:
METHOD MatchCriteria( oFound )
ENDCLASS
thtml.prg 430 THTMLITERATORSCAN:METHOD New( oNodeTop ) CLASS THtmlIteratorScan
METHOD New( oNodeTop ) CLASS THtmlIteratorScan
::Super:New( oNodeTop )
RETURN Self
thtml.prg 436 THTMLITERATORSCAN:METHOD MatchCriteria( oFound ) CLASS THtmlIteratorScan
METHOD MatchCriteria( oFound ) CLASS THtmlIteratorScan
LOCAL xData
IF ::cName != NIL .and. !( Lower(::cName) == Lower(oFound:htmlTagName) )
RETURN .F.
ENDIF
IF ::cAttribute != NIL .and. .not. hb_HHasKey( oFound:getAttributes(), ::cAttribute )
RETURN .F.
ENDIF
IF ::cValue != NIL
xData := oFound:getAttributes()
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(" ")
/* NOTE: != changed to !( == ) */
IF Empty(xData) .OR. !( Alltrim(::cData) == Alltrim(xData) )
RETURN .F.
ENDIF
ENDIF
RETURN .T.
thtml.prg 440 CLASS THtmlIteratorRegex FROM THtmlIterator MODULE FRIENDLY
CLASS THtmlIteratorRegex FROM THtmlIterator MODULE FRIENDLY
METHOD New( oNodeTop ) CONSTRUCTOR
HIDDEN:
METHOD MatchCriteria( oFound )
ENDCLASS
thtml.prg 472 THTMLITERATORREGEX:METHOD New( oNodeTop ) CLASS THtmlIteratorRegex
METHOD New( oNodeTop ) CLASS THtmlIteratorRegex
::Super:New( oNodeTop )
RETURN Self
thtml.prg 479 THTMLITERATORREGEX:METHOD MatchCriteria( oFound ) CLASS THtmlIteratorRegex
METHOD MatchCriteria( oFound ) CLASS THtmlIteratorRegex
LOCAL xData
IF ::cName != NIL .and. .not. 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
RETURN .F.
ENDIF
IF ::cValue != NIL .and.;
hb_hScan( oFound:getAttributes(), {|xKey, cValue| HB_SYMBOL_UNUSED(xKey), hb_regexLike( ::cValue, cValue ) } ) == 0
RETURN .F.
ENDIF
IF ::cData != NIL
xData := oFound:getText(" ")
IF Empty(xData) .OR. .NOT. hb_regexHas( Alltrim(::cData), Alltrim(xData) )
RETURN .F.
ENDIF
ENDIF
RETURN .T.
thtml.prg 484 CLASS THtmlNode MODULE FRIENDLY
CLASS THtmlNode MODULE FRIENDLY
HIDDEN:
DATA root
DATA _document
DATA parent
DATA htmlContent
METHOD parseHtml
METHOD parseHtmlFixed
METHOD _getTextNode
METHOD _setTextNode
METHOD keepFormatting
EXPORTED:
DATA htmlTagName READONLY
DATA htmlEndTagName READONLY
DATA htmlTagType READONLY
DATA htmlAttributes READONLY
METHOD new( oParent, cTagName, cAttrib, cContent )
METHOD isType( nCM_TYPE )
ACCESS isEmpty()
ACCESS isInline()
ACCESS isOptional()
ACCESS isNode()
ACCESS isBlock()
METHOD addNode( oTHtmlNode )
METHOD insertAfter( oTHtmlNode )
METHOD insertBefore( oTHtmlNode )
METHOD delete()
// Messages from TXmlNode
MESSAGE insertBelow METHOD addNode
MESSAGE unlink METHOD delete
METHOD firstNode()
METHOD lastNode()
ACCESS nextNode()
ACCESS prevNode()
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 )
METHOD toString( nIndent )
METHOD attrToString()
METHOD collect()
METHOD getText( cCRLF )
METHOD getAttribute( cAttrName )
METHOD getAttributes()
METHOD setAttribute( cAttrName, cAttrValue )
METHOD setAttributes( cHtmlAttr )
METHOD delAttribute( cAttrName )
METHOD delAttributes()
METHOD isAttribute()
ACCESS text INLINE ::_getTextNode()
ASSIGN text(x) INLINE ::_setTextNode(x)
ACCESS attr INLINE ::getAttributes()
ASSIGN attr(x) INLINE ::setAttributes(x)
METHOD pushNode OPERATOR +
METHOD popNode OPERATOR -
METHOD findNodeByTagName
METHOD findNodesByTagName
ERROR HANDLER noMessage
METHOD noAttribute
ENDCLASS
thtml.prg 513 THTMLNODE:METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode
METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode
IF .NOT. slInit
THtmlInit(.T.)
ENDIF
IF Valtype( oParent ) == "C"
// a HTML string is passed -> build new tree of objects
IF Chr(9) $ oParent
oParent := StrTran( oParent, Chr(9), Chr(32) )
ENDIF
::root := self
::htmlTagName := "_root_"
::htmlTagType := THtmlTagType( "_root_" )
::htmlContent := {}
::parseHtml( P_PARSER( oParent ) )
ELSEIF Valtype( oParent ) == "O"
// a HTML object is passed -> we are in the course of building an object tree
::root := oParent:root
::parent := oParent
IF Valtype( cAttrib ) == "C"
IF Right( cAttrib, 1 ) == "/"
cAttrib := Stuff( cAttrib, Len( cAttrib ), 1, " " )
::htmlEndTagName := "/"
::htmlAttributes := Trim( cAttrib )
ELSE
::htmlAttributes := cAttrib
ENDIF
ELSE
::htmlAttributes := cAttrib
ENDIF
::htmlTagName := cTagName
::htmlTagType := THtmlTagType( cTagName )
::htmlContent := IIF( cContent == NIL, {}, cContent )
ELSE
RETURN ::error( "Parameter error", ::className(), ":new()", EG_ARG, HB_AParams() )
ENDIF
RETURN self
thtml.prg 598 THTMLNODE:METHOD isType( nType ) CLASS THtmlNode
METHOD isType( nType ) CLASS THtmlNode
LOCAL lRet
BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
lRet := hb_bitAnd( ::htmlTagType[2], nType ) > 0
RECOVER
lRet := .F.
END
RETURN lRet
thtml.prg 638 THTMLNODE:METHOD isEmpty CLASS THtmlNode
METHOD isEmpty CLASS THtmlNode
RETURN hb_bitAnd( ::htmlTagType[2], CM_EMPTY ) > 0
thtml.prg 651 THTMLNODE:METHOD isInline CLASS THtmlNode
METHOD isInline CLASS THtmlNode
RETURN hb_bitAnd( ::htmlTagType[2], CM_INLINE ) > 0
thtml.prg 656 THTMLNODE:METHOD isOptional CLASS THtmlNode
METHOD isOptional CLASS THtmlNode
RETURN hb_bitAnd( ::htmlTagType[2], CM_OPT ) > 0
thtml.prg 661 THTMLNODE:METHOD isNode CLASS THtmlNode
METHOD isNode CLASS THtmlNode
RETURN Valtype( ::htmlContent ) == "A" .AND. Len( ::htmlContent ) > 0
thtml.prg 666 THTMLNODE:METHOD isBlock CLASS THtmlNode
METHOD isBlock CLASS THtmlNode
RETURN hb_bitAnd( ::htmlTagType[2], CM_BLOCK ) > 0
thtml.prg 671 THTMLNODE:METHOD keepFormatting CLASS THtmlNode
METHOD keepFormatting CLASS THtmlNode
RETURN "<" + Lower( ::htmlTagName ) + ">" $ (",
