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

2012-06-04 00:40 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbziparc/ziparc.prg
    ! fixed for unicode in another location
    % optimization to prev unicode fix

  * contrib/hbtip/thtml.prg
    ! fixed chr() usage for unicode mode
    * formatted (hbformat and manual)
    % deleted excessive parantheses

  * contrib/hbtip/cgi.prg
  * contrib/hbtip/httpcli.prg
  * contrib/hbtip/client.prg
  * contrib/hbtip/tests/base64.prg
    ! fread()/fwrite() calls fixed for unicode
    ! fixed some more anomalies, like wrongly checkingg fwrite() for
      negative result, calling fread() with 4 parameters, passing
      buffer by reference to fwrite(), minor optimizations and formatting.

  * contrib/hbtip/url.prg
    * formatting

  ; build tested only
This commit is contained in:
Viktor Szakats
2012-06-03 22:41:28 +00:00
parent 510767f0c9
commit d32355e590
8 changed files with 2981 additions and 2726 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
harbour/ChangeLog
View File

@@ -16,6 +16,30 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-06-04 00:40 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbziparc/ziparc.prg
! fixed for unicode in another location
% optimization to prev unicode fix
* contrib/hbtip/thtml.prg
! fixed chr() usage for unicode mode
* formatted (hbformat and manual)
% deleted excessive parantheses
* contrib/hbtip/cgi.prg
* contrib/hbtip/httpcli.prg
* contrib/hbtip/client.prg
* contrib/hbtip/tests/base64.prg
! fread()/fwrite() calls fixed for unicode
! fixed some more anomalies, like wrongly checkingg fwrite() for
negative result, calling fread() with 4 parameters, passing
buffer by reference to fwrite(), minor optimizations and formatting.
* contrib/hbtip/url.prg
* formatting
; build tested only
2012-06-03 23:14 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbqt/qtcore/hbqt.h
! deleted hbqt_par_QString() macro. It was not translating

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

@@ -117,7 +117,7 @@ METHOD New() CLASS TIpCgi
LOCAL nRead
LOCAL cTemp
::bSavedErrHandler := ErrorBlock( { |e| ::ErrHandler( e ) } )
::bSavedErrHandler := ErrorBlock( {| e | ::ErrHandler( e ) } )
::cCgiHeader := ""
::cHtmlPage := ""
@@ -126,8 +126,8 @@ METHOD New() CLASS TIpCgi
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 ) )
IF ( ( nRead := FRead( CGI_IN, @cTemp, nLen ) ) != nLen )
::ErrHandler( "post error read " + hb_ntos( nRead ) + " instead of " + hb_ntos( nLen ) )
ELSE
::HTTP_RAW_POST_DATA := cTemp
aTemp := hb_ATokens( cTemp, "&" )
@@ -191,24 +191,20 @@ METHOD Redirect( cUrl ) 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 } )
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 )
lRet := ( FWrite( CGI_OUT, cStream ) == hb_BLen( cStream ) )
IF ::lDumpHtml
IF Empty( ::cDumpSavePath )
@@ -227,17 +223,14 @@ METHOD Flush() CLASS TIpCgi
cFile := ::cSessionSavePath + "SESSIONID_" + cSID
cSession := ::SessionEncode()
nFileSize := Len( cSession )
IF ( nH := FCreate( cFile, FC_NORMAL ) ) != F_ERROR
IF ( FWrite( nH, @cSession, nFileSize ) ) != nFileSize
::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
cSession := ::SessionEncode()
IF FWrite( nH, cSession ) != hb_BLen( cSession )
::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_CStr( FError() ) )
ENDIF
FClose( nH )
ELSE
::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_CStr( FError() ) )
ENDIF
ENDIF
@@ -247,17 +240,13 @@ METHOD SaveHtmlPage( cFile ) CLASS TIpCgi
LOCAL nFile
LOCAL lSuccess
LOCAL nLen
LOCAL cStream
cStream := ::cHtmlPage + _CRLF
nLen := Len( cStream )
nFile := FCreate( cFile )
IF nFile != F_ERROR
lSuccess := ( FWrite( nFile, cStream, nLen ) == nLen )
cStream := ::cHtmlPage + _CRLF
lSuccess := ( FWrite( nFile, cStream ) == hb_BLen( cStream ) )
FClose( nFile )
ELSE
lSuccess := .F.
@@ -299,8 +288,8 @@ METHOD StartSession( cSID ) CLASS TIpCgi
nFileSize := FSeek( nH, 0, FS_END )
FSeek( nH, 0, FS_SET )
cBuffer := Space( nFileSize )
IF ( FRead( nH, @cBuffer, nFileSize ) ) != nFileSize
::ErrHandler( "ERROR: On reading session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
IF ( FRead( nH, @cBuffer, nFileSize ) ) != nFileSize
::ErrHandler( "ERROR: On reading session file : " + cFile + ", File error : " + hb_CStr( FError() ) )
ELSE
::SessionDecode( cBuffer )
ENDIF
@@ -313,7 +302,7 @@ METHOD StartSession( cSID ) CLASS TIpCgi
ELSE
::CreateSID()
::hSession := {=>}
::hSession := { => }
ENDIF
@@ -348,7 +337,7 @@ METHOD DestroySession( cID ) CLASS TIpCgi
cFile := ::cSessionSavePath + "SESSIONID_" + cSID
IF !( lRet := ( FErase( cFile ) == 0 ) )
::Write( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
::Write( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_CStr( FError() ) )
ELSE
::hCookies[ "SESSIONID" ] := cSID + "; expires= " + TIP_DateToGMT( Date() - 1 )
::CreateSID()
@@ -455,7 +444,7 @@ STATIC FUNCTION HtmlAllTag( hTags, cSep )
DEFAULT cSep TO " "
hb_HEval( hTags, { |k| cVal += HtmlTag( hTags, k ) + cSep } )
hb_HEval( hTags, {| k | cVal += HtmlTag( hTags, k ) + cSep } )
RETURN cVal
@@ -490,7 +479,7 @@ STATIC FUNCTION HtmlAllOption( hOptions, cSep )
IF ! Empty( hOptions )
DEFAULT cSep TO " "
hb_HEval( hOptions, { |k| cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } )
hb_HEval( hOptions, {| k | cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } )
ENDIF
RETURN cVal
@@ -521,7 +510,7 @@ STATIC FUNCTION HtmlAllValue( hValues, cSep )
IF ! Empty( hValues )
DEFAULT cSep TO " "
hb_HEval( hValues, { |k| cVal += HtmlValue( hValues, k ) + cSep } )
hb_HEval( hValues, {| k | cVal += HtmlValue( hValues, k ) + cSep } )
ENDIF
RETURN cVal
@@ -547,7 +536,7 @@ STATIC FUNCTION HtmlScript( hVal, cKey )
ENDIF
IF ISARRAY( cVal )
cTmp := ""
ascan( cVal, { | cFile | cTmp += '<script src="' + cFile + '" type="text/javascript"></script>' + _CRLF } )
AScan( cVal, {| cFile | cTmp += '<script src="' + cFile + '" type="text/javascript"></script>' + _CRLF } )
cRet += cTmp
ENDIF
ENDIF
@@ -558,7 +547,7 @@ STATIC FUNCTION HtmlScript( hVal, cKey )
ENDIF
IF ISARRAY( cVal )
cTmp := ""
ascan( cVal, { | cVar | cTmp += cVar } )
AScan( cVal, {| cVar | cTmp += cVar } )
cRet += '<script type="text/javascript">' + _CRLF + '<!--' + _CRLF + cTmp + _CRLF + '-->' + _CRLF + '</script>' + _CRLF
ENDIF
ENDIF
@@ -590,7 +579,7 @@ STATIC FUNCTION HtmlStyle( hVal, cKey )
ENDIF
IF ISARRAY( cVal )
cTmp := ""
AScan( cVal, { | cFile | cTmp += '<link rel="StyleSheet" href="' + cFile + '" type="text/css">' + _CRLF } )
AScan( cVal, {| cFile | cTmp += '<link rel="StyleSheet" href="' + cFile + '" type="text/css">' + _CRLF } )
cRet += cTmp
ENDIF
ENDIF
@@ -601,7 +590,7 @@ STATIC FUNCTION HtmlStyle( hVal, cKey )
ENDIF
IF ISARRAY( cVal )
cTmp := ""
ascan( cVal, { |cVar| cTmp += cVar } )
AScan( cVal, {| cVar | cTmp += cVar } )
cRet += '<style type="text/css">' + _CRLF + '<!--' + _CRLF + cTmp + _CRLF + '-->' + _CRLF + '</style>' + _CRLF
ENDIF
ENDIF
@@ -633,7 +622,7 @@ STATIC FUNCTION HtmlLinkRel( hVal, cKey )
ENDIF
IF ISARRAY( cVal )
cTmp := ""
AScan( cVal, { | aVal | cTmp += '<link rel="' + aVal[1] + '" href="' + aVal[2] + '"/>' + _CRLF } )
AScan( cVal, {| aVal | cTmp += '<link rel="' + aVal[ 1 ] + '" href="' + aVal[ 2 ] + '"/>' + _CRLF } )
cRet += cTmp
ENDIF
ENDIF

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

@@ -354,8 +354,8 @@ METHOD ReadHTTPProxyResponse( /* @ */ sResponse ) CLASS tIPClient
nLength := Len( sResponse )
IF nLength >= 4
bMoreDataToRead := !( ( SubStr( sResponse, nLength - 3, 1 ) == Chr( 13 ) ) .AND. ( SubStr( sResponse, nLength - 2, 1 ) == Chr( 10 ) ) .AND. ;
( SubStr( sResponse, nLength - 1, 1 ) == Chr( 13 ) ) .AND. ( SubStr( sResponse, nLength, 1 ) == Chr( 10 ) ) )
bMoreDataToRead := !( SubStr( sResponse, nLength - 3, 1 ) == Chr( 13 ) .AND. SubStr( sResponse, nLength - 2, 1 ) == Chr( 10 ) .AND. ;
SubStr( sResponse, nLength - 1, 1 ) == Chr( 13 ) .AND. SubStr( sResponse, nLength , 1 ) == Chr( 10 ) )
ENDIF
ENDDO
@@ -483,7 +483,7 @@ METHOD ReadToFile( cFile, nMode, nSize ) CLASS tIPClient
ENDIF
ENDIF
IF FWrite( nFout, cData ) < 0
IF FWrite( nFout, cData ) != hb_BLen( cData )
FClose( nFout )
RETURN .F.
ENDIF
@@ -540,7 +540,7 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient
ENDIF
nSent += nLen
IF ! Empty( ::exGauge )
hb_ExecFromArray( ::exGauge, {nSent, nSize, Self} )
hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } )
ENDIF
nLen := FRead( nFin, @cData, nBufSize )
ENDDO

22
harbour/contrib/hbtip/httpcli.prg
View File

@@ -125,9 +125,9 @@ METHOD Post( xPostData, cQuery ) CLASS tIPClientHTTP
cData := ""
y := Len( xPostData )
FOR nI := 1 TO y
cTmp := tip_URLEncode( AllTrim( hb_cStr( hb_HKeyAt( xPostData, nI ) ) ) )
cTmp := tip_URLEncode( AllTrim( hb_CStr( hb_HKeyAt( xPostData, nI ) ) ) )
cData += cTmp + "="
cTmp := tip_URLEncode( hb_cStr( hb_HValueAt( xPostData, nI ) ) )
cTmp := tip_URLEncode( hb_CStr( hb_HValueAt( xPostData, nI ) ) )
cData += cTmp
IF nI != y
cData += "&"
@@ -137,9 +137,9 @@ METHOD Post( xPostData, cQuery ) CLASS tIPClientHTTP
cData := ""
y := Len( xPostData )
FOR nI := 1 TO y
cTmp := tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 1 ] ) ) )
cTmp := tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 1 ] ) ) )
cData += cTmp + "="
cTmp := tip_URLEncode( hb_cStr( xPostData[ nI, 2 ] ) )
cTmp := tip_URLEncode( hb_CStr( xPostData[ nI, 2 ] ) )
cData += cTmp
IF nI != y
cData += "&"
@@ -507,17 +507,17 @@ METHOD PostMultiPart( xPostData, cQuery ) CLASS tIPClientHTTP
ELSEIF hb_isHash( xPostData )
y := Len( xPostData )
FOR nI := 1 TO y
cTmp := tip_URLEncode( AllTrim( hb_cStr( hb_HKeyAt( xPostData, nI ) ) ) )
cTmp := tip_URLEncode( AllTrim( hb_CStr( hb_HKeyAt( xPostData, nI ) ) ) )
cData += cBound + cCrlf + 'Content-Disposition: form-data; name="' + cTmp + '"' + cCrlf + cCrLf
cTmp := tip_URLEncode( AllTrim( hb_cStr( hb_HValueAt( xPostData, nI ) ) ) )
cTmp := tip_URLEncode( AllTrim( hb_CStr( hb_HValueAt( xPostData, nI ) ) ) )
cData += cTmp + cCrLf
NEXT
ELSEIF hb_isArray( xPostData )
y := Len( xPostData )
FOR nI := 1 TO y
cTmp := tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 1 ] ) ) )
cTmp := tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 1 ] ) ) )
cData += cBound + cCrlf + 'Content-Disposition: form-data; name="' + cTmp + '"' + cCrlf + cCrLf
cTmp := tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 2 ] ) ) )
cTmp := tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 2 ] ) ) )
cData += cTmp + cCrLf
NEXT
@@ -551,7 +551,7 @@ METHOD PostMultiPart( xPostData, cQuery ) CLASS tIPClientHTTP
DO WHILE nRead == nBuf
// nRead := FRead( nFile, @cBuf, nBuf )
cBuf := FReadStr( nFile, nBuf )
nRead := Len( cBuf )
nRead := hb_BLen( cBuf )
/* IF nRead < nBuf
cBuf := PadR( cBuf, nRead )
ENDIF
@@ -590,13 +590,11 @@ METHOD WriteAll( cFile ) CLASS tIPClientHTTP
LOCAL nFile
LOCAL lSuccess
LOCAL nLen
LOCAL cStream
IF ( nFile := FCreate( cFile ) ) != F_ERROR
cStream := ::ReadAll()
nLen := Len( cStream )
lSuccess := ( FWrite( nFile, cStream, nLen ) == nLen )
lSuccess := ( FWrite( nFile, cStream ) == hb_BLen( cStream ) )
FClose( nFile )
ELSE
lSuccess := .F.

6
harbour/contrib/hbtip/tests/base64.prg
View File

@@ -86,13 +86,13 @@ PROCEDURE MAIN( ... )
nLen := FRead( hInput, @cBuffer, 1024 )
DO WHILE nLen > 0
IF nLen < 1024
cData += SubStr( cBuffer, 1, nLen )
cData += hb_BLeft( cBuffer, nLen )
ELSE
cData += cBuffer
ENDIF
nLen := FRead( hInput, @cBuffer, 1024 )
ENDDO
IF hInput <> hSTDIN
IF hInput != hSTDIN
FClose( hInput )
ENDIF
@@ -105,7 +105,7 @@ PROCEDURE MAIN( ... )
/* Writing stream */
FWrite( hOutput, cData )
IF hOutput <> hSTDOUT
IF hOutput != hSTDOUT
FClose( hOutput )
ENDIF

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

File diff suppressed because it is too large Load Diff

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

@@ -207,8 +207,8 @@ METHOD AddGetForm( xPostData )
IF hb_isHash( xPostData )
y := Len( xPostData )
FOR nI := 1 TO y
cData += tip_URLEncode( AllTrim( hb_cStr( hb_HKeyAt( xPostData, nI ) ) ) ) + "="
cData += tip_URLEncode( AllTrim( hb_cStr( hb_HValueAt( xPostData, nI ) ) ) )
cData += tip_URLEncode( AllTrim( hb_CStr( hb_HKeyAt( xPostData, nI ) ) ) ) + "="
cData += tip_URLEncode( AllTrim( hb_CStr( hb_HValueAt( xPostData, nI ) ) ) )
IF nI != y
cData += "&"
ENDIF
@@ -216,8 +216,8 @@ METHOD AddGetForm( xPostData )
ELSEIF hb_isArray( xPostData )
y := Len( xPostData )
FOR nI := 1 TO y
cData += tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 1 ] ) ) ) + "="
cData += tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 2 ] ) ) )
cData += tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 1 ] ) ) ) + "="
cData += tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 2 ] ) ) )
IF nI != y
cData += "&"
ENDIF

4
harbour/contrib/hbziparc/ziparc.prg
View File

@@ -383,7 +383,7 @@ FUNCTION hb_ZipFile( cFileName,;
Eval( bProgress, nRead, nSize )
ENDIF
hb_ZipFileWrite( hZip, hb_BLeft( cBuffer, nLen ), nLen )
hb_ZipFileWrite( hZip, cBuffer, nLen )
ENDDO
hb_ZipFileClose( hZip )
@@ -472,7 +472,7 @@ FUNCTION hb_UnzipFile( cFileName, bUpdate, lWithPath, cPassword, cPath, acFiles,
ENDIF
nRead := 0
DO WHILE ( nLen := hb_UnzipFileRead( hUnzip, @cBuffer, Len( cBuffer ) ) ) > 0
DO WHILE ( nLen := hb_UnzipFileRead( hUnzip, @cBuffer, hb_BLen( cBuffer ) ) ) > 0
IF hb_isBlock( bProgress )
nRead += nLen
Eval( bProgress, nRead, nSize )