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

2008-06-19 01:53 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* contrib/hbw32/tests/testdll.prg
   * source/rtl/colorind.c
   * contrib/hbodbc/odbc.c
     * Minor cleanups.

   * contrib/hbtip/tests/base64.prg
   * contrib/hbtip/tests/dbtohtml.prg
   * contrib/hbtip/tests/httpadv.prg
   * contrib/hbtip/tests/tipmail.prg
   * contrib/hbtip/tests/tipmmail.prg
   * contrib/hbtip/tests/tiptest.prg
     ! All tip tests fixed and tested to compile/link
       with Harbour.
     * Changed to not require hbw32.lib.
       [TOMERGE RC1]

   + contrib/hbtip/tests/test.dbf
     + Added for tests.
       [TOMERGE RC1]
This commit is contained in:
Viktor Szakats
2008-06-19 00:02:50 +00:00
parent c6bbd0eacb
commit 2349c4e895
11 changed files with 56 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
harbour/ChangeLog
View File

@@ -8,6 +8,27 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-06-19 01:53 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* contrib/hbw32/tests/testdll.prg
* source/rtl/colorind.c
* contrib/hbodbc/odbc.c
* Minor cleanups.
* contrib/hbtip/tests/base64.prg
* contrib/hbtip/tests/dbtohtml.prg
* contrib/hbtip/tests/httpadv.prg
* contrib/hbtip/tests/tipmail.prg
* contrib/hbtip/tests/tipmmail.prg
* contrib/hbtip/tests/tiptest.prg
! All tip tests fixed and tested to compile/link
with Harbour.
* Changed to not require hbw32.lib.
[TOMERGE RC1]
+ contrib/hbtip/tests/test.dbf
+ Added for tests.
[TOMERGE RC1]
2008-06-18 11:39 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* source/rtl/gtclip.c
! hb_gt_w32_setClipboard() fix to CF_UNICODETEXT

4
harbour/contrib/hbodbc/odbc.c
View File

@@ -246,10 +246,10 @@ HB_FUNC( SQLGETDATA ) /* HB_SQLGETDATA( hStmt, nField, nType, nLen, @cBuffer ) -
int iReallocs = 0;
lLen = ( SDWORD )( hb_parnl( 4 ) ? hb_parnl( 4 ) : 64 );
bBuffer = hb_xgrab( (ULONG) lLen+1 );
bBuffer = hb_xgrab( (ULONG) lLen + 1 );
bOut = NULL;
lInitBuff = lLen;
wType = ( hb_parni( 3 ) ? hb_parni( 3 ) : SQL_BINARY );
wType = hb_parni( 3 ) ? hb_parni( 3 ) : SQL_BINARY;
wResult = ! SQL_NO_DATA;
while( wResult != SQL_NO_DATA )

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

@@ -31,7 +31,7 @@ PROCEDURE MAIN( ... )
/* Parameter parsing */
FOR nLen := 1 TO PCount()
cData := Lower( PValue( nLen ) )
cData := Lower( hb_PValue( nLen ) )
DO CASE
CASE cData == '-h'
lHelp := .T.

21
harbour/contrib/hbtip/tests/dbtohtml.prg
View File

@@ -10,12 +10,12 @@ PROCEDURE Main
LOCAL nDll, pApi
CLS
TRY
USE ..\Test.dbf
CATCH
? "Error: Database not found TEST.DBF"
BEGIN SEQUENCE
USE test.dbf
RECOVER
? "Error: Database not found test.dbf"
QUIT
END
END SEQUENCE
oDoc := THtmlDocument():new()
@@ -84,8 +84,8 @@ PROCEDURE Main
DbCloseArea()
IF oDoc:writeFile( "Address.html" )
? "File created: Address.html"
IF oDoc:writeFile( "address.html" )
? "File created: address.html"
ELSE
? "Error: ", FError()
ENDIF
@@ -93,10 +93,7 @@ PROCEDURE Main
WAIT
? HtmlToOem( oDoc:body:getText() )
nDll := DllLoad( "Shell32.dll" )
pApi := GetProcAddress( nDll, "ShellExecute" )
// DllCall( "shell32.dll", NIL, "ShellExecute", 0, "open", "address.html", NIL, "", 1 )
hb_run( "address.html" )
CallDll( pApi, 0, "open", "Address.html", NIL, "", 1 )
DllUnload( nDll )
RETURN

2
harbour/contrib/hbtip/tests/httpadv.prg
View File

@@ -34,7 +34,7 @@ PROCEDURE MAIN( cUrl )
IF oCon:Get( oUrl:cPath )
? "Get Sucessful"
FOR i := 1 to Len( oCon:hHeaders )
? HGetkeyAt( oCon:hHeaders, i ) +":", HGetValueAt( oCon:hHeaders, i )
? hb_HKeyAt( oCon:hHeaders, i ) +":", hb_HValueAt( oCon:hHeaders, i )
NEXT
ELSE
? "Get failure (server reply:", oCon:cReply , ")"

BIN
harbour/contrib/hbtip/tests/test.dbf Normal file
View File

Binary file not shown.

2
harbour/contrib/hbtip/tests/tipmail.prg
View File

@@ -32,7 +32,7 @@ PROCEDURE MAIN( cFileName )
WITH OBJECT oMail
? "-------------============== HEADERS =================--------------"
FOR i := 1 TO Len( :hHeaders )
? hb_HGetKeyAt( :hHeaders, i ), ":", hb_HGetValueAt( :hHeaders, i )
? hb_HKeyAt( :hHeaders, i ), ":", hb_HValueAt( :hHeaders, i )
NEXT
?

18
harbour/contrib/hbtip/tests/tipmmail.prg
View File

@@ -40,7 +40,7 @@ PROCEDURE MAIN( ... )
i := 1
DO WHILE i < PCount()
cData := PValue(i)
cData := hb_PValue(i)
IF lower( cData ) == "-h"
Usage()
@@ -49,35 +49,35 @@ PROCEDURE MAIN( ... )
IF lower( cData ) == "-f"
i++
cData := PValue(i)
cData := hb_PValue(i)
IF cData != NIL
oMail:hHeaders[ "From" ] := cData
ENDIF
ELSEIF lower( cData ) == "-t"
i++
cData := PValue(i)
cData := hb_PValue(i)
IF cData != NIL
oMail:hHeaders[ "To" ] := cData
ENDIF
ELSEIF lower( cData ) == "-s"
i++
cData := PValue(i)
cData := hb_PValue(i)
IF cData != NIL
oMail:hHeaders[ "Subject" ] := cData
ENDIF
ELSEIF lower( cData ) == "-b"
i++
cData := PValue(i)
cData := hb_PValue(i)
IF cData != NIL
oMail:SetBody( cData + e"\r\n" )
ENDIF
ELSEIF lower( cData ) == "-m"
i++
cData := PValue(i)
cData := hb_PValue(i)
IF cData != NIL
cData := Memoread( cData )
IF Empty(cData)
? "FATAL: Can't read", PValue(i)
? "FATAL: Can't read", hb_PValue(i)
QUIT
ENDIF
oMail:SetBody( cData + e"\r\n")
@@ -85,14 +85,14 @@ PROCEDURE MAIN( ... )
ELSE // it is an attachment file
cData := Memoread( cData )
IF Empty(cData)
? "FATAL: Can't read attachment", PValue(i)
? "FATAL: Can't read attachment", hb_PValue(i)
QUIT
ENDIF
oAttach := TipMail():New()
oAttach:SetEncoder( "base64" )
//TODO: mime type magic auto-finder
HB_FNameSplit( PValue(i),,@cFname, @cFext )
HB_FNameSplit( hb_PValue(i),,@cFname, @cFext )
// Some EMAIL readers use Content-Type to check for filename
oAttach:hHeaders[ "Content-Type" ] := ;
"application/X-TIP-Attachment; filename=";

4
harbour/contrib/hbtip/tests/tiptest.prg
View File

@@ -115,7 +115,7 @@ PROCEDURE MAIN( cUrl, cFile )
IF oClient:WriteFromFile( cFile )
@7,5 SAY "Data sucessfully sent"
ELSE
@7,5 SAY "ERROR: Data not sent", oClient:lastErrorMessage()
@7,5 SAY "ERROR: Data not sent " + oClient:lastErrorMessage()
ENDIF
ELSE
IF Empty( cFile )
@@ -124,7 +124,7 @@ PROCEDURE MAIN( cUrl, cFile )
@7,5 SAY "First 80 characters:"
? Trim(SubStr( cData, 1, 80 ))
ELSE
@7,5 SAY "ERROR - file can't be retreived", oClient:lastErrorMessage()
@7,5 SAY "ERROR - file can't be retreived " + oClient:lastErrorMessage()
ENDIF
ELSE
IF oClient:ReadToFile( cFile )

44
harbour/contrib/hbw32/tests/testdll.prg
View File

@@ -36,48 +36,8 @@
#define MB_RIGHT 0x00080000
#define MB_RTLREADING 0x00100000
#define CSIDL_DESKTOP 0x0000 // <desktop>
#define CSIDL_INTERNET 0x0001 // Internet Explorer (icon on desktop)
#define CSIDL_PROGRAMS 0x0002 // Start Menu\Programs
#define CSIDL_CONTROLS 0x0003 // My Computer\Control Panel
#define CSIDL_PRINTERS 0x0004 // My Computer\Printers
#define CSIDL_PERSONAL 0x0005 // My Documents
#define CSIDL_FAVORITES 0x0006 // <user name>\Favorites
#define CSIDL_STARTUP 0x0007 // Start Menu\Programs\Startup
#define CSIDL_RECENT 0x0008 // <user name>\Recent
#define CSIDL_SENDTO 0x0009 // <user name>\SendTo
#define CSIDL_BITBUCKET 0x000a // <desktop>\Recycle Bin
#define CSIDL_STARTMENU 0x000b // <user name>\Start Menu
#define CSIDL_DESKTOPDIRECTORY 0x0010 // <user name>\Desktop
#define CSIDL_DRIVES 0x0011 // My Computer
#define CSIDL_NETWORK 0x0012 // Network Neighborhood
#define CSIDL_NETHOOD 0x0013 // <user name>\nethood
#define CSIDL_FONTS 0x0014 // windows\fonts
#define CSIDL_TEMPLATES 0x0015
#define CSIDL_COMMON_STARTMENU 0x0016 // All Users\Start Menu
#define CSIDL_COMMON_PROGRAMS 0X0017 // All Users\Programs
#define CSIDL_COMMON_STARTUP 0x0018 // All Users\Startup
#define CSIDL_COMMON_DESKTOPDIRECTORY 0x0019 // All Users\Desktop
#define CSIDL_APPDATA 0x001a // <user name>\Application Data
#define CSIDL_PRINTHOOD 0x001b // <user name>\PrintHood
#define CSIDL_LOCAL_APPDATA 0x001c // <user name>\Local Settings\Applicaiton Data (non roaming)
#define CSIDL_ALTSTARTUP 0x001d // non localized startup
#define CSIDL_COMMON_ALTSTARTUP 0x001e // non localized common startup
#define CSIDL_COMMON_FAVORITES 0x001f
#define CSIDL_INTERNET_CACHE 0x0020
#define CSIDL_COOKIES 0x0021
#define CSIDL_HISTORY 0x0022
#define CSIDL_COMMON_APPDATA 0x0023 // All Users\Application Data
#define CSIDL_WINDOWS 0x0024 // GetWindowsDirectory()
#define CSIDL_SYSTEM 0x0025 // GetSystemDirectory()
#define CSIDL_PROGRAM_FILES 0x0026 // C:\Program Files
#define CSIDL_MYPICTURES 0x0027 // C:\Program Files\My Pictures
#define CSIDL_PROFILE 0x0028 // USERPROFILE
#define CSIDL_PROGRAM_FILES_COMMON 0x002b // C:\Program Files\Common
#define CSIDL_COMMON_TEMPLATES 0x002d // All Users\Templates
#define CSIDL_COMMON_DOCUMENTS 0x002e // All Users\Documents
#define CSIDL_COMMON_ADMINTOOLS 0x002f // All Users\Start Menu\Programs\Administrative Tools
#define CSIDL_ADMINTOOLS 0x0030 // <user name>\Start Menu\Programs\Administrative Tools
#define CSIDL_APPDATA 0x001a /* <username>\Application Data */
#define CSIDL_ADMINTOOLS 0x0030 /* <username>\Start Menu\Programs\Administrative Tools */
#define MAX_PATH 260

21
harbour/source/rtl/colorind.c
View File

@@ -6,7 +6,7 @@
* Harbour Project source code:
* HB_COLORINDEX() function
*
* Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
* Copyright 1999-2008 Viktor Szakats <viktor.szakats@syenar.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -56,13 +56,12 @@ HB_FUNC( HB_COLORINDEX )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) )
{
char * pszColor = hb_parcx( 1 );
char * pszColor = hb_parc( 1 );
ULONG ulColorPos;
ULONG ulColorLen;
USHORT uiColorIndex = ( USHORT ) hb_parni( 2 );
/* Skip the given number of commas */
for( ulColorPos = 0; pszColor[ ulColorPos ] != '\0' && uiColorIndex > 0; ulColorPos++ )
{
if( pszColor[ ulColorPos ] == ',' )
@@ -70,27 +69,24 @@ HB_FUNC( HB_COLORINDEX )
}
/* if found, continue */
if( uiColorIndex == 0 )
{
/* Skip the spaces after the comma */
while( pszColor[ ulColorPos ] == ' ' ) ulColorPos++;
while( pszColor[ ulColorPos ] == ' ' )
ulColorPos++;
/* Search for next comma or end of string */
ulColorLen = 0;
while( pszColor[ ulColorPos + ulColorLen ] != '\0' &&
pszColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++;
pszColor[ ulColorPos + ulColorLen ] != ',' )
ulColorLen++;
/* Skip the trailing spaces */
while( ulColorLen > 0 &&
pszColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--;
pszColor[ ulColorPos + ulColorLen - 1 ] == ' ' )
ulColorLen--;
/* Return the string */
hb_retclen( pszColor + ulColorPos, ulColorLen );
}
else
@@ -99,4 +95,3 @@ HB_FUNC( HB_COLORINDEX )
else
hb_retc( NULL );
}