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

20000317-18:00 GMT+1 Victor Szakats <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
2000-03-17 17:02:40 +00:00
parent c5d03ef2f3
commit 7dddab2fa4
62 changed files with 4794 additions and 2764 deletions
Download Patch File Download Diff File Expand all files Collapse all files

75
harbour/ChangeLog
View File

@@ -1,3 +1,78 @@
20000317-18:00 GMT+1 Victor Szakats <info@szelvesz.hu>
* source/vm/maindll.c
! __BORLAND__ -> __BORLANDC__
* source/rtl/environ.c
! GETENV() - Fixed handling of the second parameter.
* include/hbapi.h
source/rtl/strings.c
* HB_ISSPACE() macro moved to the central header.
* utils/hbtest/hbtest.prg
* DTOS() -> DTOC() in header.
+ source/vm/arrayshb.c
source/vm/arrays.c
source/vm/Makefile
makefile.bc
makefile.vc
+ Separated the Harbour and C array API level.
+ source/rtl/abs.c
+ source/rtl/accept.c
+ source/rtl/ampm.c
+ source/rtl/at.c
+ source/rtl/chrasc.c
+ source/rtl/colorind.c
+ source/rtl/datec.c
+ source/rtl/dateshb.c
+ source/rtl/defpath.c
+ source/rtl/eval.c
+ source/rtl/fkmax.c
+ source/rtl/fnsplit.c
+ source/rtl/getenv.c
+ source/rtl/gx.c
+ source/rtl/left.c
+ source/rtl/lennum.c
+ source/rtl/maxrow.c
+ source/rtl/minmax.c
+ source/rtl/mod.c
+ source/rtl/pad.c
+ source/rtl/replic.c
+ source/rtl/right.c
+ source/rtl/round.c
+ source/rtl/run.c
+ source/rtl/saverest.c
+ source/rtl/seconds.c
+ source/rtl/setcurs.c
+ source/rtl/setpos.c
+ source/rtl/shadow.c
+ source/rtl/space.c
+ source/rtl/str.c
+ source/rtl/strcase.c
+ source/rtl/stris.c
+ source/rtl/strmatch.c
+ source/rtl/strtran.c
+ source/rtl/strzero.c
+ source/rtl/stuff.c
+ source/rtl/substr.c
+ source/rtl/trim.c
+ source/rtl/val.c
+ source/rtl/valtostr.c
source/rtl/strings.c
source/rtl/console.c
source/rtl/dates.c
source/rtl/math.c
source/rtl/inkey.c
source/rtl/samples.c
source/rtl/do.c
source/rtl/environ.c
source/rtl/set.c
source/rtl/setcolor.c
source/rtl/filesys.c
source/rtl/Makefile
makefile.bc
makefile.vc
+ Separated almost all RTL source files into smaller pieces.
There are 41 new files now. The original CA-Cl*pper source filenames
were used where possible.
20000317-10:53 GMT+1 Victor Szakats <info@szelvesz.hu>
* include/hbclass.ch
! To avoid warning _CLASS_NAME_ is #undef-ed before #define-ed.

5
harbour/include/hbapi.h
View File

@@ -343,6 +343,11 @@ extern PHB_ITEM hb_arrayClone( PHB_ITEM pArray );
/* string management */
#define HB_ISSPACE( c ) ( ( c ) == ' ' || \
( c ) == HB_CHAR_HT || \
( c ) == HB_CHAR_LF || \
( c ) == HB_CHAR_CR )
extern int hb_stricmp( const char * s1, const char * s2 );
extern int hb_strnicmp( const char * s1, const char * s2, ULONG ulLen );
extern char * hb_strupr( char * pszText );

214
harbour/makefile.bc
View File

@@ -96,28 +96,47 @@ HBDOC_EXE = $(BIN_DIR)\hbdoc.exe
#
RTL_LIB_OBJS = \
$(OBJ_DIR)\abs.obj \
$(OBJ_DIR)\accept.obj \
$(OBJ_DIR)\ampm.obj \
$(OBJ_DIR)\at.obj \
$(OBJ_DIR)\binnum.obj \
$(OBJ_DIR)\chrasc.obj \
$(OBJ_DIR)\colorind.obj \
$(OBJ_DIR)\console.obj \
$(OBJ_DIR)\copyfile.obj \
$(OBJ_DIR)\datec.obj \
$(OBJ_DIR)\dates.obj \
$(OBJ_DIR)\dateshb.obj \
$(OBJ_DIR)\defpath.obj \
$(OBJ_DIR)\descend.obj \
$(OBJ_DIR)\dir.obj \
$(OBJ_DIR)\do.obj \
$(OBJ_DIR)\empty.obj \
$(OBJ_DIR)\environ.obj \
$(OBJ_DIR)\errorapi.obj \
$(OBJ_DIR)\eval.obj \
$(OBJ_DIR)\filesys.obj \
$(OBJ_DIR)\fkmax.obj \
$(OBJ_DIR)\fnsplit.obj \
$(OBJ_DIR)\getenv.obj \
$(OBJ_DIR)\gtapi.obj \
$(OBJ_DIR)\gx.obj \
$(OBJ_DIR)\hardcr.obj \
$(OBJ_DIR)\inkey.obj \
$(OBJ_DIR)\isprint.obj \
$(OBJ_DIR)\langapi.obj \
$(OBJ_DIR)\left.obj \
$(OBJ_DIR)\len.obj \
$(OBJ_DIR)\lennum.obj \
$(OBJ_DIR)\math.obj \
$(OBJ_DIR)\maxrow.obj \
$(OBJ_DIR)\memofile.obj \
$(OBJ_DIR)\memoline.obj \
$(OBJ_DIR)\minmax.obj \
$(OBJ_DIR)\mlcount.obj \
$(OBJ_DIR)\mlpos.obj \
$(OBJ_DIR)\mod.obj \
$(OBJ_DIR)\mouseapi.obj \
$(OBJ_DIR)\mtran.obj \
$(OBJ_DIR)\natmsg.obj \
@@ -125,15 +144,37 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\oemansi.obj \
$(OBJ_DIR)\oldbox.obj \
$(OBJ_DIR)\oldclear.obj \
$(OBJ_DIR)\pad.obj \
$(OBJ_DIR)\replic.obj \
$(OBJ_DIR)\right.obj \
$(OBJ_DIR)\round.obj \
$(OBJ_DIR)\run.obj \
$(OBJ_DIR)\samples.obj \
$(OBJ_DIR)\saverest.obj \
$(OBJ_DIR)\seconds.obj \
$(OBJ_DIR)\set.obj \
$(OBJ_DIR)\setcolor.obj \
$(OBJ_DIR)\setcurs.obj \
$(OBJ_DIR)\setpos.obj \
$(OBJ_DIR)\shadow.obj \
$(OBJ_DIR)\soundex.obj \
$(OBJ_DIR)\space.obj \
$(OBJ_DIR)\str.obj \
$(OBJ_DIR)\strcase.obj \
$(OBJ_DIR)\strings.obj \
$(OBJ_DIR)\stris.obj \
$(OBJ_DIR)\strmatch.obj \
$(OBJ_DIR)\strtran.obj \
$(OBJ_DIR)\strzero.obj \
$(OBJ_DIR)\stuff.obj \
$(OBJ_DIR)\substr.obj \
$(OBJ_DIR)\tone.obj \
$(OBJ_DIR)\trace.obj \
$(OBJ_DIR)\transfrm.obj \
$(OBJ_DIR)\trim.obj \
$(OBJ_DIR)\type.obj \
$(OBJ_DIR)\val.obj \
$(OBJ_DIR)\valtostr.obj \
$(OBJ_DIR)\valtype.obj \
$(OBJ_DIR)\word.obj \
$(OBJ_DIR)\xhelp.obj \
@@ -302,6 +343,7 @@ COMMON_LIB_OBJS = \
VM_LIB_OBJS = \
$(OBJ_DIR)\arrays.obj \
$(OBJ_DIR)\arrayshb.obj \
$(OBJ_DIR)\break.obj \
$(OBJ_DIR)\classes.obj \
$(OBJ_DIR)\cmdarg.obj \
@@ -608,6 +650,10 @@ $(OBJ_DIR)\arrays.obj : $(VM_DIR)\arrays.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(VM_LIB) -+$@,,
$(OBJ_DIR)\arrayshb.obj : $(VM_DIR)\arrayshb.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(VM_LIB) -+$@,,
$(OBJ_DIR)\break.obj : $(VM_DIR)\break.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(VM_LIB) -+$@,,
@@ -699,6 +745,14 @@ $(OBJ_DIR)\symbols.obj : $(VM_DIR)\symbols.asm
# RTL.LIB dependencies
#
$(OBJ_DIR)\abs.obj : $(RTL_DIR)\abs.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\accept.obj : $(RTL_DIR)\accept.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\achoice.c : $(RTL_DIR)\achoice.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -720,6 +774,10 @@ $(OBJ_DIR)\alert.obj : $(OBJ_DIR)\alert.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\ampm.obj : $(RTL_DIR)\ampm.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\asort.c : $(RTL_DIR)\asort.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -727,6 +785,10 @@ $(OBJ_DIR)\asort.obj : $(OBJ_DIR)\asort.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\at.obj : $(RTL_DIR)\at.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\binnum.obj : $(RTL_DIR)\binnum.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -745,6 +807,14 @@ $(OBJ_DIR)\browse.obj : $(OBJ_DIR)\browse.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\chrasc.obj : $(RTL_DIR)\chrasc.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\colorind.obj : $(RTL_DIR)\colorind.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\console.obj : $(RTL_DIR)\console.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -753,10 +823,22 @@ $(OBJ_DIR)\copyfile.obj : $(RTL_DIR)\copyfile.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\datec.obj : $(RTL_DIR)\datec.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\datehb.obj : $(RTL_DIR)\datehb.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\dates.obj : $(RTL_DIR)\dates.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\dateshb.obj : $(RTL_DIR)\dateshb.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\dbedit.c : $(RTL_DIR)\dbedit.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -764,6 +846,10 @@ $(OBJ_DIR)\dbedit.obj : $(OBJ_DIR)\dbedit.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\defpath.obj : $(RTL_DIR)\defpath.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\descend.obj : $(RTL_DIR)\descend.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -816,6 +902,10 @@ $(OBJ_DIR)\errorsys.obj : $(OBJ_DIR)\errorsys.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\eval.obj : $(RTL_DIR)\eval.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\fieldbl.c : $(RTL_DIR)\fieldbl.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -827,6 +917,18 @@ $(OBJ_DIR)\filesys.obj : $(RTL_DIR)\filesys.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\fkmax.obj : $(RTL_DIR)\fkmax.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\fnsplit.obj : $(RTL_DIR)\fnsplit.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\getenv.obj : $(RTL_DIR)\getenv.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\gtapi.obj : $(RTL_DIR)\gtapi.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -835,6 +937,10 @@ $(OBJ_DIR)\gtxxx.obj : $(RTL_DIR)\gtxxx.c
$(CC) $(CLIBFLAGS) -I$(RTL_DIR) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\gx.obj : $(RTL_DIR)\gx.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\hardcr.obj : $(RTL_DIR)\hardcr.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -858,14 +964,30 @@ $(OBJ_DIR)\langapi.obj : $(RTL_DIR)\langapi.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\left.obj : $(RTL_DIR)\left.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\len.obj : $(RTL_DIR)\len.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\lennum.obj : $(RTL_DIR)\lennum.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\math.obj : $(RTL_DIR)\math.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\maxrow.obj : $(RTL_DIR)\maxrow.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\minmax.obj : $(RTL_DIR)\minmax.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\memofile.obj : $(RTL_DIR)\memofile.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -896,6 +1018,10 @@ $(OBJ_DIR)\mlpos.obj : $(RTL_DIR)\mlpos.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\mod.obj : $(RTL_DIR)\mod.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\mouseapi.obj : $(RTL_DIR)\mouseapi.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -939,6 +1065,10 @@ $(OBJ_DIR)\oldclear.obj : $(RTL_DIR)\oldclear.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\pad.obj : $(RTL_DIR)\pad.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\readkey.c : $(RTL_DIR)\readkey.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -946,10 +1076,34 @@ $(OBJ_DIR)\readkey.obj : $(OBJ_DIR)\readkey.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\replic.obj : $(RTL_DIR)\replic.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\right.obj : $(RTL_DIR)\right.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\round.obj : $(RTL_DIR)\round.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\run.obj : $(RTL_DIR)\run.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\samples.obj : $(RTL_DIR)\samples.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\saverest.obj : $(RTL_DIR)\saverest.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\seconds.obj : $(RTL_DIR)\seconds.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\set.obj : $(RTL_DIR)\set.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -958,6 +1112,10 @@ $(OBJ_DIR)\setcolor.obj : $(RTL_DIR)\setcolor.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\setcurs.obj : $(RTL_DIR)\setcurs.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\setfunc.c : $(RTL_DIR)\setfunc.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -972,6 +1130,10 @@ $(OBJ_DIR)\setkey.obj : $(OBJ_DIR)\setkey.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\setpos.obj : $(RTL_DIR)\setpos.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\setta.c : $(RTL_DIR)\setta.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -979,14 +1141,54 @@ $(OBJ_DIR)\setta.obj : $(OBJ_DIR)\setta.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\shadow.obj : $(RTL_DIR)\shadow.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\soundex.obj : $(RTL_DIR)\soundex.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\space.obj : $(RTL_DIR)\space.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\str.obj : $(RTL_DIR)\str.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\strcase.obj : $(RTL_DIR)\strcase.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\strings.obj : $(RTL_DIR)\strings.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\stris.obj : $(RTL_DIR)\stris.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\strmatch.obj : $(RTL_DIR)\strmatch.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\strtran.obj : $(RTL_DIR)\strtran.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\strzero.obj : $(RTL_DIR)\strzero.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\stuff.obj : $(RTL_DIR)\stuff.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\substr.obj : $(RTL_DIR)\substr.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\tbcolumn.c : $(RTL_DIR)\tbcolumn.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
@@ -1062,6 +1264,10 @@ $(OBJ_DIR)\treport.obj : $(OBJ_DIR)\treport.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\trim.obj : $(RTL_DIR)\trim.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\type.obj : $(RTL_DIR)\type.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -1073,6 +1279,14 @@ $(OBJ_DIR)\typefile.obj : $(OBJ_DIR)\typefile.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\val.obj : $(RTL_DIR)\val.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\valtostr.obj : $(RTL_DIR)\valtostr.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\valtype.obj : $(RTL_DIR)\valtype.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,

42
harbour/makefile.vc
View File

@@ -160,28 +160,47 @@ LIBS2 = \
$(MAKE) -nologo /$(MK_FLAGS) /f$(MK_FILE) $(RTL_LIB)2
RTL_LIB_OBJS = \
$(OBJ_DIR)\abs.obj \
$(OBJ_DIR)\accept.obj \
$(OBJ_DIR)\ampm.obj \
$(OBJ_DIR)\at.obj \
$(OBJ_DIR)\binnum.obj \
$(OBJ_DIR)\chrasc.obj \
$(OBJ_DIR)\colorind.obj \
$(OBJ_DIR)\console.obj \
$(OBJ_DIR)\copyfile.obj \
$(OBJ_DIR)\datec.obj \
$(OBJ_DIR)\dates.obj \
$(OBJ_DIR)\dateshb.obj \
$(OBJ_DIR)\defpath.obj \
$(OBJ_DIR)\descend.obj \
$(OBJ_DIR)\dir.obj \
$(OBJ_DIR)\do.obj \
$(OBJ_DIR)\empty.obj \
$(OBJ_DIR)\environ.obj \
$(OBJ_DIR)\errorapi.obj \
$(OBJ_DIR)\eval.obj \
$(OBJ_DIR)\filesys.obj \
$(OBJ_DIR)\fkmax.obj \
$(OBJ_DIR)\fnsplit.obj \
$(OBJ_DIR)\getenv.obj \
$(OBJ_DIR)\gtapi.obj \
$(OBJ_DIR)\gx.obj \
$(OBJ_DIR)\hardcr.obj \
$(OBJ_DIR)\inkey.obj \
$(OBJ_DIR)\isprint.obj \
$(OBJ_DIR)\langapi.obj \
$(OBJ_DIR)\left.obj \
$(OBJ_DIR)\len.obj \
$(OBJ_DIR)\lennum.obj \
$(OBJ_DIR)\math.obj \
$(OBJ_DIR)\maxrow.obj \
$(OBJ_DIR)\memofile.obj \
$(OBJ_DIR)\memoline.obj \
$(OBJ_DIR)\minmax.obj \
$(OBJ_DIR)\mlcount.obj \
$(OBJ_DIR)\mlpos.obj \
$(OBJ_DIR)\mod.obj \
$(OBJ_DIR)\mouseapi.obj \
$(OBJ_DIR)\mtran.obj \
$(OBJ_DIR)\natmsg.obj \
@@ -189,15 +208,37 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\oemansi.obj \
$(OBJ_DIR)\oldbox.obj \
$(OBJ_DIR)\oldclear.obj \
$(OBJ_DIR)\pad.obj \
$(OBJ_DIR)\replic.obj \
$(OBJ_DIR)\right.obj \
$(OBJ_DIR)\round.obj \
$(OBJ_DIR)\run.obj \
$(OBJ_DIR)\samples.obj \
$(OBJ_DIR)\saverest.obj \
$(OBJ_DIR)\seconds.obj \
$(OBJ_DIR)\set.obj \
$(OBJ_DIR)\setcolor.obj \
$(OBJ_DIR)\setcurs.obj \
$(OBJ_DIR)\setpos.obj \
$(OBJ_DIR)\shadow.obj \
$(OBJ_DIR)\soundex.obj \
$(OBJ_DIR)\space.obj \
$(OBJ_DIR)\str.obj \
$(OBJ_DIR)\strcase.obj \
$(OBJ_DIR)\strings.obj \
$(OBJ_DIR)\stris.obj \
$(OBJ_DIR)\strmatch.obj \
$(OBJ_DIR)\strtran.obj \
$(OBJ_DIR)\strzero.obj \
$(OBJ_DIR)\stuff.obj \
$(OBJ_DIR)\substr.obj \
$(OBJ_DIR)\tone.obj \
$(OBJ_DIR)\trace.obj \
$(OBJ_DIR)\transfrm.obj \
$(OBJ_DIR)\trim.obj \
$(OBJ_DIR)\type.obj \
$(OBJ_DIR)\val.obj \
$(OBJ_DIR)\valtostr.obj \
$(OBJ_DIR)\valtype.obj \
$(OBJ_DIR)\word.obj \
$(OBJ_DIR)\xhelp.obj \
@@ -448,6 +489,7 @@ COMMON_LIB_OBJS = \
VM_LIB_OBJS = \
$(OBJ_DIR)\arrays.obj \
$(OBJ_DIR)\arrayshb.obj \
$(OBJ_DIR)\break.obj \
$(OBJ_DIR)\classes.obj \
$(OBJ_DIR)\cmdarg.obj \

44
harbour/source/rtl/Makefile
View File

@@ -5,44 +5,88 @@
ROOT = ../../
C_SOURCES=\
abs.c \
accept.c \
ampm.c \
at.c \
binnum.c \
chrasc.c \
colorind.c \
console.c \
copyfile.c \
datec.c \
dates.c \
dateshb.c \
defpath.c \
descend.c \
dir.c \
do.c \
empty.c \
environ.c \
errorapi.c \
eval.c \
filesys.c \
fkmax.c \
fnsplit.c \
getenv.c \
gtapi.c \
gtxxx.c \
gx.c \
hardcr.c \
inkey.c \
isprint.c \
langapi.c \
left.c \
len.c \
lennum.c \
math.c \
maxrow.c \
memofile.c \
memoline.c \
minmax.c \
mlcount.c \
mlpos.c \
mod.c \
mouseapi.c \
mousexxx.c \
msgxxx.c \
mtran.c \
natmsg.c \
net.c \
oemansi.c \
oldbox.c \
oldclear.c \
pad.c \
replic.c \
right.c \
round.c \
run.c \
samples.c \
saverest.c \
seconds.c \
set.c \
setcolor.c \
setcurs.c \
setpos.c \
shadow.c \
soundex.c \
space.c \
str.c \
strcase.c \
strings.c \
stris.c \
strmatch.c \
strtran.c \
strzero.c \
stuff.c \
substr.c \
tone.c \
trace.c \
transfrm.c \
trim.c \
type.c \
val.c \
valtostr.c \
valtype.c \
word.c \
xhelp.c \

87
harbour/source/rtl/abs.c Normal file
View File

@@ -0,0 +1,87 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* ABS() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
HARBOUR HB_ABS( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber )
{
int iWidth;
int iDec;
hb_itemGetNLen( pNumber, &iWidth, &iDec );
if( IS_INTEGER( pNumber ) )
{
int iNumber = hb_itemGetNI( pNumber );
if( iNumber >= 0 )
hb_retnilen( iNumber, iWidth );
else
hb_retni( -iNumber );
}
else if( IS_LONG( pNumber ) )
{
long lNumber = hb_itemGetNL( pNumber );
if( lNumber >= 0 )
hb_retnllen( lNumber, iWidth );
else
hb_retnl( -lNumber );
}
else if( IS_DOUBLE( pNumber ) )
{
double dNumber = hb_itemGetND( pNumber );
hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, iDec );
}
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

103
harbour/source/rtl/accept.c Normal file
View File

@@ -0,0 +1,103 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* ACCEPT command related functions
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* HB___ACCEPTSTR()
*
* See doc/license.txt for licensing terms.
*
*/
#include "hbapi.h"
#include "hbapigt.h"
#include "inkey.ch"
extern HARBOUR HB_QOUT( void );
#define ACCEPT_BUFFER_LEN 256 /* length of input buffer for ACCEPT command */
static char s_szAcceptResult[ ACCEPT_BUFFER_LEN ] = { '\0' };
HARBOUR HB___ACCEPT( void )
{
int input;
ULONG ulLen;
/* cPrompt(s) passed ? */
if( hb_pcount() >= 1 )
HB_QOUT();
ulLen = 0;
input = 0;
while( input != K_ENTER )
{
/* Wait forever, for keyboard events only */
input = hb_inkey( 0.0, ( HB_inkey_enum ) INKEY_KEYBOARD, 1, 1 );
switch( input )
{
case K_BS:
case K_LEFT:
if( ulLen > 0 )
{
hb_gtWriteCon( ( BYTE * ) "\x8 \x8", 3 ); /* Erase it from the screen. */
ulLen--; /* Adjust input count to get rid of last character */
}
break;
default:
if( ulLen < ( ACCEPT_BUFFER_LEN - 1 ) && input >= 32 )
{
s_szAcceptResult[ ulLen ] = input; /* Accept the input */
hb_gtWriteCon( ( BYTE * ) &s_szAcceptResult[ ulLen ], sizeof( char ) ); /* Then display it */
ulLen++; /* Then adjust the input count */
}
}
}
s_szAcceptResult[ ulLen ] = '\0';
hb_retc( s_szAcceptResult );
}
HARBOUR HB___ACCEPTSTR( void )
{
hb_retc( s_szAcceptResult );
}

80
harbour/source/rtl/ampm.c Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* AMPM() compatibility function from the SAMPLES directory of Clipper.
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
HARBOUR HB_AMPM( void )
{
char * pszTime = hb_parc( 1 );
ULONG ulTimeLen = hb_parclen( 1 );
char * pszResult = ( char * ) hb_xgrab( HB_MAX_( ulTimeLen, 2 ) + 3 + 1 );
USHORT uiHour = ( USHORT ) hb_strVal( pszTime );
BOOL bAM;
memset( pszResult, '\0', 3 );
memcpy( pszResult, pszTime, ulTimeLen );
if( uiHour == 0 || uiHour == 24 )
{
if( ulTimeLen < 2 )
ulTimeLen = 2;
pszResult[ 0 ] = '1';
pszResult[ 1 ] = '2';
bAM = TRUE;
}
else if( uiHour > 12 )
{
if( ulTimeLen < 2 )
ulTimeLen = 2;
uiHour -= 12;
pszResult[ 0 ] = ( char ) ( uiHour / 10 ) + '0';
pszResult[ 1 ] = ( char ) ( uiHour % 10 ) + '0';
if( pszResult[ 0 ] == '0' )
pszResult[ 0 ] = ' ';
bAM = FALSE;
}
else
bAM = ( uiHour != 12 );
strcpy( pszResult + ulTimeLen, bAM ? " am" : " pm" );
hb_retclen( pszResult, ulTimeLen + 3 );
hb_xfree( pszResult );
}

99
harbour/source/rtl/at.c Normal file
View File

@@ -0,0 +1,99 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* AT(), RAT() functions
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* locates a substring in a string */
/* TEST: QOUT( "at( 'cde', 'abcdefgfedcba' ) = '" + at( 'cde', 'abcsefgfedcba' ) + "'" ) */
HARBOUR HB_AT( void )
{
PHB_ITEM pSub = hb_param( 1, IT_STRING );
PHB_ITEM pText = hb_param( 2, IT_STRING );
if( pText && pSub )
{
hb_retnl( hb_strAt( hb_itemGetCPtr( pSub ), hb_itemGetCLen( pSub ),
hb_itemGetCPtr( pText ), hb_itemGetCLen( pText ) ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1108, NULL, "AT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* locates a substring in a string starting at the end */
/* TEST: QOUT( "rat( 'cde', 'abcdefgfedcba' ) = '" + rat( 'cde', 'abcdefgfedcba' ) + "'" ) */
/* TOFIX: Will not work with a search string > 64 KB on some platforms */
HARBOUR HB_RAT( void )
{
ULONG ulSubLen = hb_parclen( 1 );
if( ulSubLen )
{
long lPos = hb_parclen( 2 ) - ulSubLen;
if( lPos >= 0 )
{
char * szSub = hb_parc( 1 );
char * szText = hb_parc( 2 );
BOOL bFound = FALSE;
while( lPos >= 0 && !bFound )
{
if( *( szText + lPos ) == *szSub )
bFound = ( memcmp( szSub, szText + lPos, ulSubLen ) == 0 );
lPos--;
}
hb_retnl( bFound ? lPos + 2 : 0 );
}
else
hb_retni( 0 );
}
else
/* This function never seems to raise an error */
hb_retni( 0 );
}

95
harbour/source/rtl/chrasc.c Normal file
View File

@@ -0,0 +1,95 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CHR(), ASC() functions
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include <ctype.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* converts an ASCII code to a character value */
HARBOUR HB_CHR( void )
{
if( ISNUM( 1 ) )
{
char szChar[ 2 ];
/* NOTE: CA-Cl*pper's compiler optimizer will be wrong for those
CHR() cases where the passed parameter is a constant which
can be divided by 256 but it's not zero, in this case it
will return an empty string instead of a Chr(0). [vszakats] */
/* Believe it or not, clipper does this! */
szChar[ 0 ] = hb_parnl( 1 ) % 256;
szChar[ 1 ] = '\0';
hb_retclen( szChar, 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1104, NULL, "CHR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* converts a character value to an ASCII code */
HARBOUR HB_ASC( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
if( hb_itemGetCLen( pText ) > 0 )
hb_retni( ( BYTE ) * ( hb_itemGetCPtr( pText ) ) );
else
hb_retni( 0 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1107, NULL, "ASC" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

85
harbour/source/rtl/colorind.c Normal file
View File

@@ -0,0 +1,85 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HB_COLORINDEX() function
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
HARBOUR HB_HB_COLORINDEX( void )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) )
{
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 ] == ',' )
uiColorIndex--;
}
/* if found, continue */
if( uiColorIndex == 0 )
{
/* Skip the spaces after the comma */
while( pszColor[ ulColorPos ] == ' ' ) ulColorPos++;
/* Search for next comma or end of string */
ulColorLen = 0;
while( pszColor[ ulColorPos + ulColorLen ] != '\0' &&
pszColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++;
/* Skip the trailing spaces */
while( ulColorLen > 0 &&
pszColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--;
/* Return the string */
hb_retclen( pszColor + ulColorPos, ulColorLen );
}
else
hb_retc( "" );
}
else
hb_retc( "" );
}

322
harbour/source/rtl/console.c
View File

@@ -37,28 +37,20 @@
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* HB___ACCEPT()
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* hb_altout(), hb_devout(), HB_DEVOUT(), hb_devpos(),
* HB_DEVPOS(), hb_dispout(), HB___EJECT(), HB_MAXCOL(),
* HB_MAXROW(), hb_out(), hb_outerr(), HB_OUTERR(),
* HB_DEVPOS(), hb_dispout(), HB___EJECT(),
* hb_out(), hb_outerr(), HB_OUTERR(),
* hb_outstd(), HB_OUTSTD(), HB_PCOL(), HB_PROW(),
* HB_SETPOS(), HB_SETPRC(), HB_SCROLL(), and hb_consoleInitialize()
* HB_SETPRC(), HB_SCROLL(), and hb_consoleInitialize()
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* hb_consoleGetNewLine()
* HB_DISPOUTAT()
* HB_SETPOSBS()
* HB_DISPBOX() (GT version)
* HB_DISPBEGIN()
* HB_DISPEND()
* HB_DISPCOUNT()
* HB_ISCOLOR()
* HB_NOSNOW()
* HB___ACCEPTSTR()
* HB_HB_COLORINDEX()
*
* See doc/license.txt for licensing terms.
*
@@ -71,7 +63,6 @@
#include "hbapigt.h"
#include "hbdate.h"
#include "hbset.h"
#include "inkey.ch"
#if defined(__GNUC__) && ! defined(__MINGW32__)
#include <unistd.h>
@@ -87,8 +78,6 @@
#include <termios.h>
#endif
#define ACCEPT_BUFFER_LEN 256 /* length of input buffer for ACCEPT command */
#if defined(OS_UNIX_COMPATIBLE)
#define CRLF_BUFFER_LEN 2 /*length of buffer for CR/LF characters */
#else
@@ -99,7 +88,6 @@ static BOOL s_bInit = FALSE;
static USHORT s_uiPRow;
static USHORT s_uiPCol;
static char s_szCrLf[ CRLF_BUFFER_LEN ];
static char s_szAcceptResult[ ACCEPT_BUFFER_LEN ];
static int s_iFilenoStdin;
static int s_iFilenoStdout;
static int s_iFilenoStderr;
@@ -119,8 +107,6 @@ void hb_consoleInitialize( void )
s_szCrLf[ 2 ] = '\0';
#endif
s_szAcceptResult[ 0 ] = '\0';
s_uiPRow = s_uiPCol = 0;
/* Some compilers open stdout and stderr in text mode, but
@@ -348,12 +334,6 @@ HARBOUR HB_DEVPOS( void ) /* Sets the screen and/or printer position */
hb_devpos( hb_parni( 1 ), hb_parni( 2 ) );
}
HARBOUR HB_SETPOS( void ) /* Sets the screen position */
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) );
}
HARBOUR HB_OUTSTD( void ) /* writes a list of values to the standard output device */
{
USHORT uiPCount = hb_pcount();
@@ -413,17 +393,6 @@ HARBOUR HB_QOUT( void )
HB_QQOUT();
}
/* Move the screen position to the right by one column */
HARBOUR HB_SETPOSBS( void )
{
SHORT iRow, iCol;
/* NOTE: Clipper does no checks about reaching the border or anything.
[vszakats] */
hb_gtGetPos( &iRow, &iCol );
hb_gtSetPos( iRow, iCol + 1 );
}
HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen or printer), but is not affected by SET ALTERNATE */
{
if( hb_pcount() >= 1 )
@@ -444,51 +413,6 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen
}
}
HARBOUR HB_DISPOUT( void ) /* writes a single value to the screen, but is not affected by SET ALTERNATE */
{
if( hb_pcount() >= 1 )
{
if( ISCHAR( 2 ) )
{
char szOldColor[ CLR_STRLEN ];
hb_gtGetColorStr( szOldColor );
hb_gtSetColorStr( hb_parc( 2 ) );
hb_out( 1, hb_dispout );
hb_gtSetColorStr( szOldColor );
}
else
hb_out( 1, hb_dispout );
}
}
/* Undocumented Clipper function */
HARBOUR HB_DISPOUTAT( void ) /* writes a single value to the screen at speficic position, but is not affected by SET ALTERNATE */
{
if( hb_pcount() >= 3 )
{
/* NOTE: Clipper does no checks here. [vszakats] */
hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) );
if( ISCHAR( 4 ) )
{
char szOldColor[ CLR_STRLEN ];
hb_gtGetColorStr( szOldColor );
hb_gtSetColorStr( hb_parc( 4 ) );
hb_out( 3, hb_dispout );
hb_gtSetColorStr( szOldColor );
}
else
hb_out( 3, hb_dispout );
}
}
/* TOFIX: CA-Cl*pper will print an eject even if SET DEVICE=SCREEN */
HARBOUR HB___EJECT( void ) /* Ejects the current page from the printer */
@@ -553,36 +477,6 @@ HARBOUR HB_SCROLL( void ) /* Scrolls a screen region */
hb_gtScroll( top, left, bottom, right, v_scroll, h_scroll );
}
HARBOUR HB_MAXROW( void ) /* Return the maximum screen row number (zero origin) */
{
hb_retni( hb_gtMaxRow() );
}
HARBOUR HB_MAXCOL( void ) /* Return the maximum screen column number (zero origin) */
{
hb_retni( hb_gtMaxCol() );
}
HARBOUR HB_ROW( void ) /* Return the current screen row position (zero origin) */
{
SHORT iRow;
SHORT iCol;
hb_gtGetPos( &iRow, &iCol );
hb_retni( iRow );
}
HARBOUR HB_COL( void ) /* Return the current screen column position (zero origin) */
{
SHORT iRow;
SHORT iCol;
hb_gtGetPos( &iRow, &iCol );
hb_retni( iCol );
}
HARBOUR HB_DISPBOX( void )
{
if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) )
@@ -735,190 +629,48 @@ HARBOUR HB_DISPCOUNT( void )
hb_retni( hb_gtDispCount() );
}
HARBOUR HB_ISCOLOR( void )
HARBOUR HB_DISPOUT( void ) /* writes a single value to the screen, but is not affected by SET ALTERNATE */
{
hb_retl( hb_gtIsColor() );
}
HARBOUR HB_NOSNOW( void )
{
if( ISLOG( 1 ) )
hb_gtSetSnowFlag( hb_parl( 1 ) );
}
HARBOUR HB_HB_SHADOW( void )
{
if( hb_pcount() >= 4 )
hb_gtDrawShadow( hb_parni( 1 ),
hb_parni( 2 ),
hb_parni( 3 ),
hb_parni( 4 ),
ISNUM( 5 ) ? hb_parni( 5 ) : 7 );
}
HARBOUR HB_DBGSHADOW( void )
{
HB_HB_SHADOW();
}
HARBOUR HB_SAVESCREEN( void )
{
USHORT uiX;
USHORT uiCoords[ 4 ];
void * pBuffer;
uiCoords[ 0 ] = ISNUM( 1 ) ? hb_parni( 1 ) : 0;
uiCoords[ 1 ] = ISNUM( 2 ) ? hb_parni( 2 ) : 0;
uiCoords[ 2 ] = ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow();
uiCoords[ 3 ] = ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol();
hb_gtRectSize( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], &uiX );
pBuffer = hb_xgrab( uiX );
hb_gtSave( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], pBuffer );
hb_retclen( ( char * ) pBuffer, uiX );
hb_xfree( ( char * ) pBuffer );
}
HARBOUR HB_RESTSCREEN( void )
{
if( ISCHAR( 5 ) )
hb_gtRest( ISNUM( 1 ) ? hb_parni( 1 ) : 0,
ISNUM( 2 ) ? hb_parni( 2 ) : 0,
ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(),
ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol(),
( void * ) hb_parc( 5 ) );
}
USHORT hb_setCursor( BOOL bSetCursor, USHORT usNewCursor )
{
USHORT usPreviousCursor;
HB_TRACE(HB_TR_DEBUG, ("hb_setCursor(%d, %hu)", (int) bSetCursor, usNewCursor));
hb_gtGetCursor( &usPreviousCursor );
if( bSetCursor )
hb_gtSetCursor( usNewCursor );
return usPreviousCursor;
}
HARBOUR HB_SETCURSOR( void )
{
hb_retni( hb_setCursor( ISNUM( 1 ), hb_parni( 1 ) ) );
}
HARBOUR HB_SETBLINK( void )
{
BOOL bPreviousBlink;
hb_gtGetBlink( &bPreviousBlink );
if( ISLOG( 1 ) )
hb_gtSetBlink( hb_parl( 1 ) );
hb_retl( bPreviousBlink );
}
HARBOUR HB_SETMODE( void )
{
hb_retl( hb_gtSetMode( ISNUM( 1 ) ? hb_parni( 1 ) : ( hb_gtMaxRow() + 1 ),
ISNUM( 2 ) ? hb_parni( 2 ) : ( hb_gtMaxCol() + 1 ) ) == 0 );
}
/* Internal Clipper function used in ACCEPT command */
/* Basically the simplest Clipper function to */
/* receive data. Parameter : cPrompt. Returns : cRet */
HARBOUR HB___ACCEPT( void )
{
int input;
ULONG ulLen;
if( hb_pcount() >= 1 ) /* cPrompt passed */
HB_QOUT();
ulLen = 0;
input = 0;
while( input != K_ENTER )
if( hb_pcount() >= 1 )
{
/* Wait forever, for keyboard events only */
input = hb_inkey( 0.0, ( HB_inkey_enum ) INKEY_KEYBOARD, 1, 1 );
switch( input )
if( ISCHAR( 2 ) )
{
case K_BS:
case K_LEFT:
if( ulLen > 0 )
{
hb_gtWriteCon( ( BYTE * ) "\x8 \x8", 3 ); /* Erase it from the screen. */
ulLen--; /* Adjust input count to get rid of last character */
}
break;
char szOldColor[ CLR_STRLEN ];
default:
if( ulLen < ( ACCEPT_BUFFER_LEN - 1 ) && input >= 32 )
{
s_szAcceptResult[ ulLen ] = input; /* Accept the input */
hb_gtWriteCon( ( BYTE * ) &s_szAcceptResult[ ulLen ], sizeof( char ) ); /* Then display it */
ulLen++; /* Then adjust the input count */
}
}
}
hb_gtGetColorStr( szOldColor );
hb_gtSetColorStr( hb_parc( 2 ) );
s_szAcceptResult[ ulLen ] = '\0';
hb_out( 1, hb_dispout );
hb_retc( s_szAcceptResult );
}
HARBOUR HB___ACCEPTSTR( void )
{
hb_retc( s_szAcceptResult );
}
HARBOUR HB_HB_COLORINDEX( void )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) )
{
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 ] == ',' )
uiColorIndex--;
}
/* if found, continue */
if( uiColorIndex == 0 )
{
/* Skip the spaces after the comma */
while( pszColor[ ulColorPos ] == ' ' ) ulColorPos++;
/* Search for next comma or end of string */
ulColorLen = 0;
while( pszColor[ ulColorPos + ulColorLen ] != '\0' &&
pszColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++;
/* Skip the trailing spaces */
while( ulColorLen > 0 &&
pszColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--;
/* Return the string */
hb_retclen( pszColor + ulColorPos, ulColorLen );
hb_gtSetColorStr( szOldColor );
}
else
hb_retc( "" );
hb_out( 1, hb_dispout );
}
}
/* Undocumented Clipper function */
HARBOUR HB_DISPOUTAT( void ) /* writes a single value to the screen at speficic position, but is not affected by SET ALTERNATE */
{
if( hb_pcount() >= 3 )
{
/* NOTE: Clipper does no checks here. [vszakats] */
hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) );
if( ISCHAR( 4 ) )
{
char szOldColor[ CLR_STRLEN ];
hb_gtGetColorStr( szOldColor );
hb_gtSetColorStr( hb_parc( 4 ) );
hb_out( 3, hb_dispout );
hb_gtSetColorStr( szOldColor );
}
else
hb_out( 3, hb_dispout );
}
else
hb_retc( "" );
}

107
harbour/source/rtl/datec.c Normal file
View File

@@ -0,0 +1,107 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CMONTH(), CDOW() functions
*
* Copyright 1999 Jose Lalin <dezac@corevia.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapierr.h"
#include "hbapiitm.h"
#include "hbdate.h"
char * hb_cmonth( int iMonth )
{
HB_TRACE(HB_TR_DEBUG, ("hb_cmonth(%d)", iMonth));
return ( iMonth >= 1 && iMonth <= 12 ) ? hb_monthsname[ iMonth - 1 ] : "";
}
HARBOUR HB_CMONTH( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retc( hb_cmonth( lMonth ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1116, NULL, "CMONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
char * hb_cdow( int iDay )
{
HB_TRACE(HB_TR_DEBUG, ("hb_cdow(%d)", iDay));
return ( iDay >= 1 && iDay <= 7 ) ? hb_daysname[ iDay - 1 ] : "";
}
HARBOUR HB_CDOW( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDate = hb_itemGetDL( pDate );
if( lDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( lDate, &lDay, &lMonth, &lYear );
hb_retc( hb_cdow( hb_dow( lDay, lMonth, lYear ) ) );
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1117, NULL, "CDOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

423
harbour/source/rtl/dates.c
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* The Date API
* The Date API (C level)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
@@ -38,21 +38,9 @@
* www - http://www.harbour-project.org
*
* Copyright 1999 Jose Lalin <dezac@corevia.com>
* hb_secondsToday()
* HB_SECONDS()
* hb_cmonth()
* HB_CMONTH()
* hb_cdow()
* HB_CDOW()
* HB_DAY()
* HB_MONTH()
* HB_YEAR()
* hb_dow()
* HB_DOW()
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* HB_CTOD()
* HB_DATE()
* hb_dtoc()
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
@@ -60,66 +48,16 @@
* hb_dateDecStr()
* hb_dateStrPut()
* hb_dateStrGet()
* HB_STOD()
* HB_HB_STOD()
*
* See doc/license.txt for licensing terms.
*
*/
#define HB_OS_WIN_32_USED
#include <ctype.h>
#include "hbapi.h"
#include "hbapierr.h"
#include "hbapiitm.h"
#include "hbset.h"
#include "hbdate.h"
#include <ctype.h>
#include <time.h>
#if defined( OS_UNIX_COMPATIBLE )
#include <sys/timeb.h>
#else
#include <sys\timeb.h>
#endif
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__)
#include <dos.h>
#endif
double hb_secondsToday( void )
{
#if defined(_MSC_VER)
#define timeb _timeb
#define ftime _ftime
#endif
struct timeb tb;
struct tm * oTime;
HB_TRACE(HB_TR_DEBUG, ("hb_secondsToday()"));
ftime( &tb );
oTime = localtime( &tb.time );
return ( oTime->tm_hour * 3600 ) +
( oTime->tm_min * 60 ) +
oTime->tm_sec +
( ( double ) tb.millitm / 1000 );
}
char * hb_cmonth( int iMonth )
{
HB_TRACE(HB_TR_DEBUG, ("hb_cmonth(%d)", iMonth));
return ( iMonth >= 1 && iMonth <= 12 ) ? hb_monthsname[ iMonth - 1 ] : "";
}
char * hb_cdow( int iDay )
{
HB_TRACE(HB_TR_DEBUG, ("hb_cdow(%d)", iDay));
return ( iDay >= 1 && iDay <= 7 ) ? hb_daysname[ iDay - 1 ] : "";
}
long hb_dateEncode( long lDay, long lMonth, long lYear )
{
HB_TRACE(HB_TR_DEBUG, ("hb_dateEncode(%ld, %ld, %ld)", lDay, lMonth, lYear));
@@ -247,102 +185,6 @@ long hb_dateEncStr( char * szDate )
return hb_dateEncode( lDay, lMonth, lYear );
}
HARBOUR HB_CTOD( void )
{
if( ISCHAR( 1 ) )
{
char * szDate = hb_parc( 1 );
int d_value = 0, m_value = 0, y_value = 0;
char szDateFormat[ 9 ];
if( szDate )
{
int d_pos = 0, m_pos = 0, y_pos = 0;
int count, digit, size = strlen( hb_set.HB_SET_DATEFORMAT );
for( count = 0; count < size; count++ )
{
switch( hb_set.HB_SET_DATEFORMAT[ count ] )
{
case 'D':
case 'd':
if( d_pos == 0 )
{
if( m_pos == 0 && y_pos == 0 ) d_pos = 1;
else if( m_pos == 0 || y_pos == 0 ) d_pos = 2;
else d_pos = 3;
}
break;
case 'M':
case 'm':
if( m_pos == 0 )
{
if( d_pos == 0 && y_pos == 0 ) m_pos = 1;
else if( d_pos == 0 || y_pos == 0 ) m_pos = 2;
else m_pos = 3;
}
break;
case 'Y':
case 'y':
if( y_pos == 0 )
{
if( m_pos == 0 && d_pos == 0 ) y_pos = 1;
else if( m_pos == 0 || d_pos == 0 ) y_pos = 2;
else y_pos = 3;
}
}
}
size = strlen( szDate );
for( count = 0; count < size; count++ )
{
digit = szDate[ count ];
if( isdigit( digit ) )
{
if( d_pos == 1 )
d_value = ( d_value * 10 ) + digit - '0';
else if( m_pos == 1 )
m_value = ( m_value * 10 ) + digit - '0';
else if( y_pos == 1 )
y_value = ( y_value * 10 ) + digit - '0';
}
else if( digit != ' ' )
{
d_pos--;
m_pos--;
y_pos--;
}
}
if( y_value >= 0 && y_value < 100 )
{
count = hb_set.HB_SET_EPOCH % 100;
digit = hb_set.HB_SET_EPOCH / 100;
if( y_value >= count )
y_value += ( digit * 100 );
else
y_value += ( ( digit * 100 ) + 100 );
}
}
sprintf( szDateFormat, "%04i%02i%02i", y_value, m_value, d_value );
hb_retds( szDateFormat );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1119, NULL, "CTOD" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: szFormattedDate must be an at least 11 chars wide buffer */
char * hb_dtoc( const char * szDate, char * szFormattedDate, const char * szDateFormat )
@@ -513,178 +355,6 @@ char * hb_dtoc( const char * szDate, char * szFormattedDate, const char * szDate
return szFormattedDate;
}
HARBOUR HB_DTOC( void )
{
if( ISDATE( 1 ) )
{
char szDate[ 9 ];
char szFormatted[ 11 ];
hb_retc( hb_dtoc( hb_pardsbuff( szDate, 1 ), szFormatted, hb_set.HB_SET_DATEFORMAT ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1118, NULL, "DTOC" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_DTOS( void )
{
if( ISDATE( 1 ) )
{
char szDate[ 9 ];
hb_retc( hb_pardsbuff( szDate, 1 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1120, NULL, "DTOS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
#ifdef HB_COMPAT_XPP
/* NOTE: XBase++ compatible function */
/* NOTE: XBase++ checks for the parameter count at compile time */
HARBOUR HB_STOD( void )
{
hb_retds( hb_parc( 1 ) );
}
#endif
/* NOTE: Harbour extension, exactly the same as STOD(). */
HARBOUR HB_HB_STOD( void )
{
hb_retds( hb_parc( 1 ) );
}
HARBOUR HB_YEAR( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retnllen( lYear, 5 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1112, NULL, "YEAR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_MONTH( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retnllen( lMonth, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1113, NULL, "MONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_DAY( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retnllen( lDay, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1114, NULL, "DAY" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_TIME( void )
{
char szResult[ 9 ];
#if defined(_Windows) || defined(WINNT) || defined(_WIN32)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%02d:%02d:%02d", st.wHour, st.wMinute, st.wSecond );
#else
time_t t;
struct tm * oTime;
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%02d:%02d:%02d", oTime->tm_hour, oTime->tm_min, oTime->tm_sec );
#endif
hb_retclen( szResult, 8 );
}
HARBOUR HB_DATE( void )
{
char szResult[ 9 ];
#if defined(_Windows) || defined(WINNT) || defined(_WIN32)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%04d%02d%02d", st.wYear, st.wMonth, st.wDay );
#else
time_t t;
struct tm * oTime;
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%04d%02d%02d", oTime->tm_year + 1900, oTime->tm_mon + 1, oTime->tm_mday );
#endif
hb_retds( szResult );
}
long hb_dow( long lDay, long lMonth, long lYear )
{
HB_TRACE(HB_TR_DEBUG, ("hb_dow(%ld, %ld, %ld)", lDay, lMonth, lYear));
@@ -701,92 +371,3 @@ long hb_dow( long lDay, long lMonth, long lYear )
lYear + lYear / 4 - lYear / 100 + lYear / 400 + 6 ) % 7 + 1;
}
HARBOUR HB_DOW( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDate = hb_itemGetDL( pDate );
if( lDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( lDate, &lDay, &lMonth, &lYear );
hb_retnllen( hb_dow( lDay, lMonth, lYear ), 3 );
}
else
hb_retnllen( 0, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1115, NULL, "DOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_CMONTH( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retc( hb_cmonth( lMonth ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1116, NULL, "CMONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_CDOW( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDate = hb_itemGetDL( pDate );
if( lDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( lDate, &lDay, &lMonth, &lYear );
hb_retc( hb_cdow( hb_dow( lDay, lMonth, lYear ) ) );
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1117, NULL, "CDOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_SECONDS( void )
{
hb_retnd( hb_secondsToday() );
}

375
harbour/source/rtl/dateshb.c Normal file
View File

@@ -0,0 +1,375 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Date API (Harbour level)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Jose Lalin <dezac@corevia.com>
* HB_DAY()
* HB_MONTH()
* HB_YEAR()
* HB_DOW()
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* HB_CTOD()
* HB_DATE()
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* HB_STOD()
* HB_HB_STOD()
*
* See doc/license.txt for licensing terms.
*
*/
#define HB_OS_WIN_32_USED
#include "hbapi.h"
#include "hbapierr.h"
#include "hbapiitm.h"
#include "hbset.h"
#include "hbdate.h"
#include <ctype.h>
#include <time.h>
#if defined( OS_UNIX_COMPATIBLE )
#include <sys/timeb.h>
#else
#include <sys\timeb.h>
#endif
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__)
#include <dos.h>
#endif
HARBOUR HB_CTOD( void )
{
if( ISCHAR( 1 ) )
{
char * szDate = hb_parc( 1 );
int d_value = 0, m_value = 0, y_value = 0;
char szDateFormat[ 9 ];
if( szDate )
{
int d_pos = 0, m_pos = 0, y_pos = 0;
int count, digit, size = strlen( hb_set.HB_SET_DATEFORMAT );
for( count = 0; count < size; count++ )
{
switch( hb_set.HB_SET_DATEFORMAT[ count ] )
{
case 'D':
case 'd':
if( d_pos == 0 )
{
if( m_pos == 0 && y_pos == 0 ) d_pos = 1;
else if( m_pos == 0 || y_pos == 0 ) d_pos = 2;
else d_pos = 3;
}
break;
case 'M':
case 'm':
if( m_pos == 0 )
{
if( d_pos == 0 && y_pos == 0 ) m_pos = 1;
else if( d_pos == 0 || y_pos == 0 ) m_pos = 2;
else m_pos = 3;
}
break;
case 'Y':
case 'y':
if( y_pos == 0 )
{
if( m_pos == 0 && d_pos == 0 ) y_pos = 1;
else if( m_pos == 0 || d_pos == 0 ) y_pos = 2;
else y_pos = 3;
}
}
}
size = strlen( szDate );
for( count = 0; count < size; count++ )
{
digit = szDate[ count ];
if( isdigit( digit ) )
{
if( d_pos == 1 )
d_value = ( d_value * 10 ) + digit - '0';
else if( m_pos == 1 )
m_value = ( m_value * 10 ) + digit - '0';
else if( y_pos == 1 )
y_value = ( y_value * 10 ) + digit - '0';
}
else if( digit != ' ' )
{
d_pos--;
m_pos--;
y_pos--;
}
}
if( y_value >= 0 && y_value < 100 )
{
count = hb_set.HB_SET_EPOCH % 100;
digit = hb_set.HB_SET_EPOCH / 100;
if( y_value >= count )
y_value += ( digit * 100 );
else
y_value += ( ( digit * 100 ) + 100 );
}
}
sprintf( szDateFormat, "%04i%02i%02i", y_value, m_value, d_value );
hb_retds( szDateFormat );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1119, NULL, "CTOD" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_DTOC( void )
{
if( ISDATE( 1 ) )
{
char szDate[ 9 ];
char szFormatted[ 11 ];
hb_retc( hb_dtoc( hb_pardsbuff( szDate, 1 ), szFormatted, hb_set.HB_SET_DATEFORMAT ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1118, NULL, "DTOC" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_DTOS( void )
{
if( ISDATE( 1 ) )
{
char szDate[ 9 ];
hb_retc( hb_pardsbuff( szDate, 1 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1120, NULL, "DTOS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
#ifdef HB_COMPAT_XPP
/* NOTE: XBase++ compatible function */
/* NOTE: XBase++ checks for the parameter count at compile time */
HARBOUR HB_STOD( void )
{
hb_retds( hb_parc( 1 ) );
}
#endif
/* NOTE: Harbour extension, exactly the same as STOD(). */
HARBOUR HB_HB_STOD( void )
{
hb_retds( hb_parc( 1 ) );
}
HARBOUR HB_YEAR( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retnllen( lYear, 5 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1112, NULL, "YEAR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_MONTH( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retnllen( lMonth, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1113, NULL, "MONTH" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_DAY( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear );
hb_retnllen( lDay, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1114, NULL, "DAY" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_TIME( void )
{
char szResult[ 9 ];
#if defined(_Windows) || defined(WINNT) || defined(_WIN32)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%02d:%02d:%02d", st.wHour, st.wMinute, st.wSecond );
#else
time_t t;
struct tm * oTime;
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%02d:%02d:%02d", oTime->tm_hour, oTime->tm_min, oTime->tm_sec );
#endif
hb_retclen( szResult, 8 );
}
HARBOUR HB_DATE( void )
{
char szResult[ 9 ];
#if defined(_Windows) || defined(WINNT) || defined(_WIN32)
SYSTEMTIME st;
GetLocalTime( &st );
sprintf( szResult, "%04d%02d%02d", st.wYear, st.wMonth, st.wDay );
#else
time_t t;
struct tm * oTime;
time( &t );
oTime = localtime( &t );
sprintf( szResult, "%04d%02d%02d", oTime->tm_year + 1900, oTime->tm_mon + 1, oTime->tm_mday );
#endif
hb_retds( szResult );
}
HARBOUR HB_DOW( void )
{
PHB_ITEM pDate = hb_param( 1, IT_DATE );
if( pDate )
{
long lDate = hb_itemGetDL( pDate );
if( lDate )
{
long lDay, lMonth, lYear;
hb_dateDecode( lDate, &lDay, &lMonth, &lYear );
hb_retnllen( hb_dow( lDay, lMonth, lYear ), 3 );
}
else
hb_retnllen( 0, 3 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1115, NULL, "DOW" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

77
harbour/source/rtl/defpath.c Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* DEFPATH(), __DEFPATH() functions
*
* Copyright 1999 Jose Lalin <dezac@corevia.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbset.h"
HARBOUR HB_DEFPATH( void )
{
char buffer[ _POSIX_PATH_MAX ];
char delimiter[ 2 ] = ":";
int size;
if( hb_set.HB_SET_DEFAULT )
{
/* Leave enough space to append a path delimiter */
strncpy( buffer, hb_set.HB_SET_DEFAULT, sizeof( buffer ) - 1 );
size = sizeof( buffer ) - 2;
}
buffer[ size ] = '\0';
size = strlen( buffer );
HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: buffer is |%s|, size is %d, last char is |%c|", buffer, size, buffer[ size - 1]));
HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: OS_PATH_DELIMITER is |%c| and OS_PATH_LIST_SEPARATOR is |%c|", OS_PATH_DELIMITER, OS_PATH_LIST_SEPARATOR));
/* If the path is not empty and it doesn't end with a drive or path
delimiter, then add the appropriate separator. Use ':' if the size
of the path is 1 and the list separator is not ':', otherwise use
the path delimiter. This allows the use of a drive letter delimiter
for DOS compatible operating systems while preventing it from being
with a Unix compatible OS. */
if( size && buffer[ size - 1 ] != ':' && buffer[ size - 1 ] != OS_PATH_DELIMITER )
{
if( size > 1 || OS_PATH_LIST_SEPARATOR == ':' )
delimiter[ 0 ] = OS_PATH_DELIMITER;
strcat( buffer, delimiter );
}
hb_retc( buffer );
}
HARBOUR HB___DEFPATH( void )
{
HB_DEFPATH();
}

29
harbour/source/rtl/do.c
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* DO(), EVAL() functions and DO command
* EVAL() functions and DO command
*
* Copyright 1999 Ryszard Glab <rglab@imid.med.pl>
* www - http://www.harbour-project.org
@@ -92,30 +92,3 @@ HARBOUR HB_DO( void )
}
}
HARBOUR HB_EVAL( void )
{
USHORT uiPCount = hb_pcount();
PHB_ITEM pItem = hb_param( 1, IT_BLOCK );
if( pItem )
{
USHORT uiParam;
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pItem );
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

53
harbour/source/rtl/environ.c
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Environment functions (OS(), VERSION(), __RUN(), GETENV(), etc.)
* OS(), VERSION() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
@@ -37,12 +37,6 @@
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* HB___RUN()
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* HB_GETE()
*
* Copyright 1999 Luiz Rafael Culik <culik@sl.conex.net>
* Support for determining the window version by
*
@@ -502,48 +496,3 @@ HARBOUR HB_VERSION( void )
hb_xfree( pszVersion );
}
HARBOUR HB_GETENV( void )
{
if( hb_pcount() == 1 )
{
char * szName = hb_parc( 1 );
ULONG ulName = hb_parclen( 1 );
while( ulName && szName[ ulName - 1 ] == '=' )
{
/* strip the '=' or else it will clear the variable! */
szName[ ulName - 1 ] = '\0';
ulName--;
}
if( ulName )
{
char * szValue = getenv( szName );
char * szDefault = hb_parc( 2 ) ? hb_parc( 2 ) : "";
hb_retc( szValue ? szValue : szDefault );
}
else
hb_retc( "" );
}
else
hb_retc( "" );
}
/* NOTE: Undocumented Clipper function. [vszakats] */
HARBOUR HB_GETE( void )
{
HB_GETENV();
}
HARBOUR HB___RUN( void )
{
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(_MSC_VER) || defined(__IBMCPP__) || defined(__GNUC__)
if( ISCHAR( 1 ) )
system( hb_parc( 1 ) );
#else
hb_errRT_BASE_Ext1( EG_UNSUPPORTED, 9999, NULL, "__RUN", 0, EF_CANDEFAULT );
#endif
}

67
harbour/source/rtl/eval.c Normal file
View File

@@ -0,0 +1,67 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* EVAL() functions and DO command
*
* Copyright 1999 Ryszard Glab <rglab@imid.med.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbvm.h"
HARBOUR HB_EVAL( void )
{
USHORT uiPCount = hb_pcount();
PHB_ITEM pItem = hb_param( 1, IT_BLOCK );
if( pItem )
{
USHORT uiParam;
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pItem );
for( uiParam = 2; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, IT_ANY ) );
hb_vmDo( uiPCount - 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

30
harbour/source/rtl/filesys.c
View File

@@ -52,8 +52,6 @@
* HB_DISKCHANGE()
* HB_DISKNAME()
* HB_DISKSPACE() (parts by Luiz Rafael Culik <culik@sl.conex.net>)
* HB_HB_FNAMESPLIT()
* HB_HB_FNAMEMERGE()
*
* Copyright 1999 Jose Lalin <dezac@corevia.com>
* hb_fsChDrv()
@@ -1669,34 +1667,6 @@ HARBOUR HB_CURDRIVE( void )
#endif
HARBOUR HB_HB_FNAMESPLIT( void )
{
if( ISCHAR( 1 ) )
{
PHB_FNAME pFileName = hb_fsFNameSplit( hb_parc( 1 ) );
hb_storc( pFileName->szPath, 2 );
hb_storc( pFileName->szName, 3 );
hb_storc( pFileName->szExtension, 4 );
hb_storc( pFileName->szDrive, 5 );
hb_xfree( pFileName );
}
}
HARBOUR HB_HB_FNAMEMERGE( void )
{
HB_FNAME pFileName;
char szFileName[ _POSIX_PATH_MAX ];
pFileName.szPath = ISCHAR( 1 ) ? hb_parc( 1 ) : NULL;
pFileName.szName = ISCHAR( 2 ) ? hb_parc( 2 ) : NULL;
pFileName.szExtension = ISCHAR( 3 ) ? hb_parc( 3 ) : NULL;
pFileName.szDrive = ISCHAR( 4 ) ? hb_parc( 4 ) : NULL;
hb_retc( hb_fsFNameMerge( szFileName, &pFileName ) );
}
#ifdef HB_COMPAT_C53
/* NOTE: Clipper 5.3 undocumented */

70
harbour/source/rtl/fkmax.c Normal file
View File

@@ -0,0 +1,70 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* FKMAX(), FKLABEL() functions
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */
HARBOUR HB_FKMAX( void )
{
hb_retni( 40 ); /* IBM specific */
}
/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */
HARBOUR HB_FKLABEL( void )
{
PHB_ITEM pPar1 = hb_param( 1, IT_NUMERIC );
if( pPar1 != NULL )
{
USHORT uiFKey = hb_itemGetNI( pPar1 );
if( uiFKey > 0 && uiFKey <= 40 )
{
char szName[ 4 ];
sprintf( szName, "F%i", uiFKey );
hb_retc( szName );
}
else
hb_retc( "" );
}
else
hb_retc( "" );
}

66
harbour/source/rtl/fnsplit.c Normal file
View File

@@ -0,0 +1,66 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HB_FNAMESPLIT(), HB_FNAMEMERGE() functions
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapifs.h"
HARBOUR HB_HB_FNAMESPLIT( void )
{
if( ISCHAR( 1 ) )
{
PHB_FNAME pFileName = hb_fsFNameSplit( hb_parc( 1 ) );
hb_storc( pFileName->szPath, 2 );
hb_storc( pFileName->szName, 3 );
hb_storc( pFileName->szExtension, 4 );
hb_storc( pFileName->szDrive, 5 );
hb_xfree( pFileName );
}
}
HARBOUR HB_HB_FNAMEMERGE( void )
{
HB_FNAME pFileName;
char szFileName[ _POSIX_PATH_MAX ];
pFileName.szPath = ISCHAR( 1 ) ? hb_parc( 1 ) : NULL;
pFileName.szName = ISCHAR( 2 ) ? hb_parc( 2 ) : NULL;
pFileName.szExtension = ISCHAR( 3 ) ? hb_parc( 3 ) : NULL;
pFileName.szDrive = ISCHAR( 4 ) ? hb_parc( 4 ) : NULL;
hb_retc( hb_fsFNameMerge( szFileName, &pFileName ) );
}

86
harbour/source/rtl/getenv.c Normal file
View File

@@ -0,0 +1,86 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GETENV(), GETE() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* HB_GETE()
*
* See doc/license.txt for licensing terms.
*
*/
#include "hbapi.h"
/* NOTE: The second parameter is a Harbour extension. In CA-Cl*pper the
function will return an empty string if called with more than one
parameter. [vszakats] */
HARBOUR HB_GETENV( void )
{
if( ISCHAR( 1 ) )
{
char * szName = hb_parc( 1 );
ULONG ulName = hb_parclen( 1 );
while( ulName && szName[ ulName - 1 ] == '=' )
{
/* strip the '=' or else it will clear the variable! */
szName[ ulName - 1 ] = '\0';
ulName--;
}
if( ulName )
{
char * szValue = getenv( szName );
hb_retc( szValue ? szValue : ( ( ISCHAR( 2 ) ? hb_parc( 2 ) : "" ) ) );
}
else
hb_retc( "" );
}
else
hb_retc( "" );
}
/* NOTE: Undocumented Clipper function. [vszakats] */
HARBOUR HB_GETE( void )
{
HB_GETENV();
}

66
harbour/source/rtl/gx.c Normal file
View File

@@ -0,0 +1,66 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* NOSNOW(), SETMODE(), ISCOLOR() functions
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* HB_SETMODE()
*
* See doc/license.txt for licensing terms.
*
*/
#include "hbapi.h"
#include "hbapigt.h"
HARBOUR HB_ISCOLOR( void )
{
hb_retl( hb_gtIsColor() );
}
HARBOUR HB_NOSNOW( void )
{
if( ISLOG( 1 ) )
hb_gtSetSnowFlag( hb_parl( 1 ) );
}
HARBOUR HB_SETMODE( void )
{
hb_retl( hb_gtSetMode( ISNUM( 1 ) ? hb_parni( 1 ) : ( hb_gtMaxRow() + 1 ),
ISNUM( 2 ) ? hb_parni( 2 ) : ( hb_gtMaxCol() + 1 ) ) == 0 );
}

32
harbour/source/rtl/inkey.c
View File

@@ -1036,35 +1036,3 @@ HARBOUR HB_LASTKEY( void )
hb_retni( s_inkeyLast );
}
/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */
HARBOUR HB_FKLABEL( void )
{
PHB_ITEM pPar1 = hb_param( 1, IT_NUMERIC );
if( pPar1 != NULL )
{
USHORT uiFKey = hb_itemGetNI( pPar1 );
if( uiFKey > 0 && uiFKey <= 40 )
{
char szName[ 4 ];
sprintf( szName, "F%i", uiFKey );
hb_retc( szName );
}
else
hb_retc( "" );
}
else
hb_retc( "" );
}
/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */
HARBOUR HB_FKMAX( void )
{
hb_retni( 40 ); /* IBM specific */
}

69
harbour/source/rtl/left.c Normal file
View File

@@ -0,0 +1,69 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* LEFT() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns the left-most n characters in string */
HARBOUR HB_LEFT( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText && ISNUM( 2 ) )
{
long lLen = hb_parnl( 2 );
if( lLen > ( long ) hb_itemGetCLen( pText ) )
lLen = ( long ) hb_itemGetCLen( pText );
else if( lLen < 0 )
lLen = 0;
hb_retclen( hb_itemGetCPtr( pText ), lLen );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1124, NULL, "LEFT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

58
harbour/source/rtl/lennum.c Normal file
View File

@@ -0,0 +1,58 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* LENNUM() compatibility function from the SAMPLES directory of Clipper.
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
HARBOUR HB_LENNUM( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
ULONG ulLen = 0;
if( pNumber )
{
char * pszString = hb_itemStr( pNumber, NULL, NULL );
if( pszString )
{
ulLen = strlen( pszString );
hb_strLTrim( pszString, &ulLen );
hb_xfree( pszString );
}
}
hb_retnl( ulLen );
}

329
harbour/source/rtl/math.c
View File

@@ -33,18 +33,8 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* HB_ROUND()
*
* See doc/license.txt for licensing terms.
*
*/
#include <math.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
@@ -107,54 +97,6 @@ int matherr( struct exception * err )
}
#endif
HARBOUR HB_ABS( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber )
{
int iWidth;
int iDec;
hb_itemGetNLen( pNumber, &iWidth, &iDec );
if( IS_INTEGER( pNumber ) )
{
int iNumber = hb_itemGetNI( pNumber );
if( iNumber >= 0 )
hb_retnilen( iNumber, iWidth );
else
hb_retni( -iNumber );
}
else if( IS_LONG( pNumber ) )
{
long lNumber = hb_itemGetNL( pNumber );
if( lNumber >= 0 )
hb_retnllen( lNumber, iWidth );
else
hb_retnl( -lNumber );
}
else if( IS_DOUBLE( pNumber ) )
{
double dNumber = hb_itemGetND( pNumber );
hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, iDec );
}
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_EXP( void )
{
if( ISNUM( 1 ) )
@@ -192,31 +134,6 @@ HARBOUR HB_EXP( void )
}
}
HARBOUR HB_INT( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber )
{
double dNumber = hb_itemGetND( pNumber );
int iWidth;
hb_itemGetNLen( pNumber, &iWidth, NULL );
hb_retndlen( dNumber >= 0 ? floor( dNumber ) : ceil( dNumber ), iWidth, 0 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_LOG( void )
{
if( ISNUM( 1 ) )
@@ -260,250 +177,6 @@ HARBOUR HB_LOG( void )
}
}
/* returns the maximum of two date or numerics */
HARBOUR HB_MAX( void )
{
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
/* NOTE: The order of these if() branches is significant, */
/* please, don't change it. [vszakats] */
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
int iDec1;
int iDec2;
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
if( d1 >= d2 )
hb_retndlen( d1, 0, iDec1 );
else
hb_retndlen( d2, 0, iDec2 );
}
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 >= l2 ? l1 : l2 );
}
else
{
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 >= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
char szDate[ 9 ];
hb_retds( hb_itemGetDL( p1 ) >= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns the minimum of two date or numerics */
HARBOUR HB_MIN( void )
{
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
/* NOTE: The order of these if() branches is significant, */
/* please, don't change it. [vszakats] */
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
int iDec1;
int iDec2;
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
if( d1 <= d2 )
hb_retndlen( d1, 0, iDec1 );
else
hb_retndlen( d2, 0, iDec2 );
}
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 <= l2 ? l1 : l2 );
}
else
{
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 <= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
char szDate[ 9 ];
hb_retds( hb_itemGetDL( p1 ) <= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: In Clipper this is written in Clipper, see the source below,
and the error handling is NOT made here, but in the % operator.
[vszakats] */
/* NOTE: CA-Clipper is buggy since it relies on the fact that the errorhandler
will silently handle zero division errors. [vszakats] */
/* NOTE: This C version fully emulates the behaviour of the original
CA-Cl*pper version, including bugs/side-effects. [vszakats] */
HARBOUR HB_MOD( void )
{
/*
FUNCTION MOD( cl_num, cl_base )
LOCAL cl_result := cl_num % cl_base
RETURN IF( cl_base = 0, cl_num, iif( cl_result * cl_base < 0, cl_result + cl_base, cl_result ) )
*/
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber && ISNUM( 2 ) )
{
double dNumber = hb_itemGetND( pNumber );
double dBase = hb_parnd( 2 ); /* dBase! Cool! */
if( dBase )
{
double dResult = dNumber - ( ( long ) ( dNumber / dBase ) * dBase );
if( dResult * dBase < 0 )
hb_retnd( dResult + dBase );
else
hb_retnd( dResult );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%" );
if( pResult )
{
int iDec;
hb_itemRelease( pResult );
hb_itemGetNLen( pNumber, NULL, &iDec );
hb_retndlen( dNumber, 0, iDec );
}
}
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1085, NULL, "%" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
double hb_numRound( double dResult, int iDec )
{
HB_TRACE(HB_TR_DEBUG, ("hb_numRound(%lf, %d)", dResult, iDec));
if( dResult != 0.0 )
{
if( iDec == 0 )
{
if( dResult < 0.0 )
dResult = ceil( dResult - 0.5 );
else
dResult = floor( dResult + 0.5 );
}
else if( iDec < 0 )
{
double dAdjust = pow( 10, -iDec );
if( dResult < 0.0 )
dResult = ceil( ( dResult / dAdjust ) - 0.5 );
else
dResult = floor( ( dResult / dAdjust ) + 0.5 );
dResult *= dAdjust;
}
else
{
double dAdjust = pow( 10, iDec );
if( dResult < 0.0 )
dResult = ceil( ( dResult * dAdjust ) - 0.5 );
else
dResult = floor( ( dResult * dAdjust ) + 0.5 );
dResult /= dAdjust;
}
}
return dResult;
}
HARBOUR HB_ROUND( void )
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
int iDec = hb_parni( 2 );
hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, HB_MAX_( iDec, 0 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
HARBOUR HB_SQRT( void )
{
if( ISNUM( 1 ) )

47
harbour/source/rtl/maxrow.c Normal file
View File

@@ -0,0 +1,47 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* MAXROW(), MAXCOL() functions
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapigt.h"
HARBOUR HB_MAXROW( void ) /* Return the maximum screen row number (zero origin) */
{
hb_retni( hb_gtMaxRow() );
}
HARBOUR HB_MAXCOL( void ) /* Return the maximum screen column number (zero origin) */
{
hb_retni( hb_gtMaxCol() );
}

159
harbour/source/rtl/minmax.c Normal file
View File

@@ -0,0 +1,159 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* MIN(), MAX() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns the maximum of two date or numerics */
HARBOUR HB_MAX( void )
{
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
/* NOTE: The order of these if() branches is significant, */
/* please, don't change it. [vszakats] */
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
int iDec1;
int iDec2;
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
if( d1 >= d2 )
hb_retndlen( d1, 0, iDec1 );
else
hb_retndlen( d2, 0, iDec2 );
}
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 >= l2 ? l1 : l2 );
}
else
{
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 >= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
char szDate[ 9 ];
hb_retds( hb_itemGetDL( p1 ) >= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* returns the minimum of two date or numerics */
HARBOUR HB_MIN( void )
{
PHB_ITEM p1 = hb_param( 1, IT_ANY );
PHB_ITEM p2 = hb_param( 2, IT_ANY );
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
/* NOTE: The order of these if() branches is significant, */
/* please, don't change it. [vszakats] */
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
int iDec1;
int iDec2;
hb_itemGetNLen( p1, NULL, &iDec1 );
hb_itemGetNLen( p2, NULL, &iDec2 );
if( d1 <= d2 )
hb_retndlen( d1, 0, iDec1 );
else
hb_retndlen( d2, 0, iDec2 );
}
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 <= l2 ? l1 : l2 );
}
else
{
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 <= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
char szDate[ 9 ];
hb_retds( hb_itemGetDL( p1 ) <= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

101
harbour/source/rtl/mod.c Normal file
View File

@@ -0,0 +1,101 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* MOD() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* NOTE: In Clipper this is written in Clipper, see the source below,
and the error handling is NOT made here, but in the % operator.
[vszakats] */
/* NOTE: CA-Clipper is buggy since it relies on the fact that the errorhandler
will silently handle zero division errors. [vszakats] */
/* NOTE: This C version fully emulates the behaviour of the original
CA-Cl*pper version, including bugs/side-effects. [vszakats] */
HARBOUR HB_MOD( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber && ISNUM( 2 ) )
{
double dNumber = hb_itemGetND( pNumber );
double dBase = hb_parnd( 2 ); /* dBase! Cool! */
if( dBase )
{
double dResult = dNumber - ( ( long ) ( dNumber / dBase ) * dBase );
if( dResult * dBase < 0 )
hb_retnd( dResult + dBase );
else
hb_retnd( dResult );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%" );
if( pResult )
{
int iDec;
hb_itemRelease( pResult );
hb_itemGetNLen( pNumber, NULL, &iDec );
hb_retndlen( dNumber, 0, iDec );
}
}
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1085, NULL, "%" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/*
FUNCTION MOD( cl_num, cl_base )
LOCAL cl_result := cl_num % cl_base
RETURN IF( cl_base = 0, cl_num, iif( cl_result * cl_base < 0, cl_result + cl_base, cl_result ) )
*/

227
harbour/source/rtl/pad.c Normal file
View File

@@ -0,0 +1,227 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* PAD*() functions
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbset.h"
#include "hbdate.h"
/* This function is used by all of the PAD functions to prepare the argument
being padded. If date, convert to string using hb_dtoc(). If numeric,
convert to unpadded string. Return pointer to string and set string length */
static char * hb_itemPadConv( PHB_ITEM pItem, char * buffer, ULONG * pulSize )
{
char * szText;
HB_TRACE(HB_TR_DEBUG, ("hb_itemPadCond(%p, %p, %p)", pItem, buffer, pulSize));
if( pItem )
{
if( IS_STRING( pItem ) )
{
szText = hb_itemGetCPtr( pItem );
*pulSize = hb_itemGetCLen( pItem );
}
else if( IS_DATE( pItem ) )
{
char szDate[ 9 ];
szText = hb_dtoc( hb_pardsbuff( szDate, 1 ), buffer, hb_set.HB_SET_DATEFORMAT );
*pulSize = strlen( szText );
}
else if( IS_INTEGER( pItem ) )
{
sprintf( buffer, "%d", hb_itemGetNI( pItem ) );
szText = buffer;
*pulSize = strlen( szText );
}
else if( IS_LONG( pItem ) )
{
sprintf( buffer, "%ld", hb_itemGetNL( pItem ) );
szText = buffer;
*pulSize = strlen( szText );
}
else if( IS_DOUBLE( pItem ) )
{
int iDecimal;
hb_itemGetNLen( pItem, NULL, &iDecimal );
sprintf( buffer, "%.*f", iDecimal, hb_itemGetND( pItem ) );
szText = buffer;
*pulSize = strlen( szText );
}
else
szText = NULL;
}
else
szText = NULL;
return szText;
}
/* right-pads a date, number, or string with spaces or supplied character */
/* TEST: QOUT( "padr( 'hello', 10 ) = '" + padr( 'hello', 10 ) + "'" ) */
HARBOUR HB_PADR( void )
{
ULONG ulSize;
char buffer[ 128 ];
char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize );
if( szText && ISNUM( 2 ) )
{
long lLen = hb_parnl( 2 );
if( lLen > ( long ) ulSize )
{
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
long lPos;
char cPad;
hb_xmemcpy( szResult, szText, ( long ) ulSize );
cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' );
for( lPos = ( long ) ulSize; lPos < lLen; lPos++ )
szResult[ lPos ] = cPad;
hb_retclen( szResult, ( ULONG ) lLen );
hb_xfree( szResult );
}
else
{
if( lLen < 0 )
lLen = 0;
hb_retclen( szText, lLen );
}
}
else
hb_retc( "" );
}
/* synonymn for PADR */
HARBOUR HB_PAD( void )
{
HB_PADR();
}
/* left-pads a date, number, or string with spaces or supplied character */
/* TEST: QOUT( "padl( 'hello', 10 ) = '" + padl( 'hello', 10 ) + "'" ) */
HARBOUR HB_PADL( void )
{
ULONG ulSize;
char buffer[ 128 ];
char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize );
if( szText && ISNUM( 2 ) )
{
long lLen = hb_parnl( 2 );
if( lLen > ( long ) ulSize )
{
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
long lPos = lLen - ( long ) ulSize;
char cPad;
hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize );
cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ');
for(; lPos > 0; lPos-- )
{
szResult[ lPos - 1 ] = cPad;
}
hb_retclen( szResult, lLen );
hb_xfree( szResult );
}
else
{
if( lLen < 0 )
lLen = 0;
hb_retclen( szText, lLen );
}
}
else
hb_retc( "" );
}
/* centre-pads a date, number, or string with spaces or supplied character */
/* TEST: QOUT( "padc( 'hello', 10 ) = '" + padc( 'hello', 10 ) + "'" ) */
HARBOUR HB_PADC( void )
{
ULONG ulSize;
char buffer[ 128 ];
char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize );
if( szText && ISNUM( 2 ) )
{
long lLen = hb_parnl( 2 );
if( lLen > ( long ) ulSize )
{
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
char cPad;
long w, lPos = ( lLen - ( long ) ulSize ) / 2;
hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize + 1 );
cPad = ( ISCHAR( 3 ) ? *hb_parc( 3 ) : ' ' );
for( w = 0; w < lPos; w++ )
szResult[ w ] = cPad;
for( w = ( long ) ulSize + lPos; w < lLen; w++ )
szResult[ w ] = cPad;
szResult[ lLen ] = '\0';
hb_retclen( szResult, lLen );
hb_xfree( szResult );
}
else
{
if( lLen < 0 )
lLen = 0;
hb_retclen( szText, lLen );
}
}
else
hb_retc( "" );
}

93
harbour/source/rtl/replic.c Normal file
View File

@@ -0,0 +1,93 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* REPLICATE() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns n copies of given string */
/* TEST: QOUT( "replicate( 'abc', 5 ) = " + replicate( 'abc', 5 ) ) */
HARBOUR HB_REPLICATE( void )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) )
{
long lTimes = hb_parnl( 2 );
if( lTimes > 0 )
{
ULONG ulLen = hb_parclen( 1 );
if( ( double ) ( ( double ) ulLen * ( double ) lTimes ) < ( double ) ULONG_MAX )
{
char * szText = hb_parc( 1 );
char * szResult = ( char * ) hb_xgrab( ( ulLen * lTimes ) + 1 );
char * szPtr = szResult;
long i;
for( i = 0; i < lTimes; i++ )
{
hb_xmemcpy( szPtr, szText, ulLen );
szPtr += ulLen;
}
hb_retclen( szResult, ulLen * lTimes );
hb_xfree( szResult );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_STROVERFLOW, 1234, NULL, "REPLICATE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1106, NULL, "REPLICATE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

64
harbour/source/rtl/right.c Normal file
View File

@@ -0,0 +1,64 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* LEFT() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns the right-most n characters in string */
HARBOUR HB_RIGHT( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText && ISNUM( 2 ) )
{
long lLen = hb_parnl( 2 );
if( lLen > ( long ) hb_itemGetCLen( pText ) )
lLen = ( long ) hb_itemGetCLen( pText );
else if( lLen < 0 )
lLen = 0;
hb_retclen( hb_itemGetCPtr( pText ) + hb_itemGetCLen( pText ) - lLen, lLen );
}
else
{
/* Clipper doesn't error */
hb_retc( "" );
}
}

136
harbour/source/rtl/round.c Normal file
View File

@@ -0,0 +1,136 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* ROUND(), INT() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* HB_ROUND()
*
* See doc/license.txt for licensing terms.
*
*/
#include <math.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
HARBOUR HB_INT( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber )
{
double dNumber = hb_itemGetND( pNumber );
int iWidth;
hb_itemGetNLen( pNumber, &iWidth, NULL );
hb_retndlen( dNumber >= 0 ? floor( dNumber ) : ceil( dNumber ), iWidth, 0 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
double hb_numRound( double dResult, int iDec )
{
HB_TRACE(HB_TR_DEBUG, ("hb_numRound(%lf, %d)", dResult, iDec));
if( dResult != 0.0 )
{
if( iDec == 0 )
{
if( dResult < 0.0 )
dResult = ceil( dResult - 0.5 );
else
dResult = floor( dResult + 0.5 );
}
else if( iDec < 0 )
{
double dAdjust = pow( 10, -iDec );
if( dResult < 0.0 )
dResult = ceil( ( dResult / dAdjust ) - 0.5 );
else
dResult = floor( ( dResult / dAdjust ) + 0.5 );
dResult *= dAdjust;
}
else
{
double dAdjust = pow( 10, iDec );
if( dResult < 0.0 )
dResult = ceil( ( dResult * dAdjust ) - 0.5 );
else
dResult = floor( ( dResult * dAdjust ) + 0.5 );
dResult /= dAdjust;
}
}
return dResult;
}
HARBOUR HB_ROUND( void )
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
{
int iDec = hb_parni( 2 );
hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, HB_MAX_( iDec, 0 ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

48
harbour/source/rtl/run.c Normal file
View File

@@ -0,0 +1,48 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* __RUN function
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapierr.h"
HARBOUR HB___RUN( void )
{
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(_MSC_VER) || defined(__IBMCPP__) || defined(__GNUC__)
if( ISCHAR( 1 ) )
system( hb_parc( 1 ) );
#else
hb_errRT_BASE_Ext1( EG_UNSUPPORTED, 9999, NULL, "__RUN", 0, EF_CANDEFAULT );
#endif
}

64
harbour/source/rtl/samples.c
View File

@@ -34,7 +34,6 @@
*/
#include "hbapi.h"
#include "hbapiitm.h"
/* NOTE: szTime must be 9 chars large. */
@@ -81,49 +80,6 @@ static ULONG hb_TimeStrToSec( char * pszTime )
return ulTime;
}
HARBOUR HB_AMPM( void )
{
char * pszTime = hb_parc( 1 );
ULONG ulTimeLen = hb_parclen( 1 );
char * pszResult = ( char * ) hb_xgrab( HB_MAX_( ulTimeLen, 2 ) + 3 + 1 );
USHORT uiHour = ( USHORT ) hb_strVal( pszTime );
BOOL bAM;
memset( pszResult, '\0', 3 );
memcpy( pszResult, pszTime, ulTimeLen );
if( uiHour == 0 || uiHour == 24 )
{
if( ulTimeLen < 2 )
ulTimeLen = 2;
pszResult[ 0 ] = '1';
pszResult[ 1 ] = '2';
bAM = TRUE;
}
else if( uiHour > 12 )
{
if( ulTimeLen < 2 )
ulTimeLen = 2;
uiHour -= 12;
pszResult[ 0 ] = ( char ) ( uiHour / 10 ) + '0';
pszResult[ 1 ] = ( char ) ( uiHour % 10 ) + '0';
if( pszResult[ 0 ] == '0' )
pszResult[ 0 ] = ' ';
bAM = FALSE;
}
else
bAM = ( uiHour != 12 );
strcpy( pszResult + ulTimeLen, bAM ? " am" : " pm" );
hb_retclen( pszResult, ulTimeLen + 3 );
hb_xfree( pszResult );
}
HARBOUR HB_DAYS( void )
{
hb_retnl( hb_parnl( 1 ) / 86400 );
@@ -138,26 +94,6 @@ HARBOUR HB_ELAPTIME( void )
hb_retc( hb_SecToTimeStr( szTime, ( ulEnd < ulStart ? 86400 : 0 ) + ulEnd - ulStart ) );
}
HARBOUR HB_LENNUM( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
ULONG ulLen = 0;
if( pNumber )
{
char * pszString = hb_itemStr( pNumber, NULL, NULL );
if( pszString )
{
ulLen = strlen( pszString );
hb_strLTrim( pszString, &ulLen );
hb_xfree( pszString );
}
}
hb_retnl( ulLen );
}
HARBOUR HB_SECS( void )
{
hb_retnl( hb_TimeStrToSec( hb_parc( 1 ) ) );

66
harbour/source/rtl/saverest.c Normal file
View File

@@ -0,0 +1,66 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SAVESCREEN(), RESTSCREEN() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapigt.h"
HARBOUR HB_SAVESCREEN( void )
{
USHORT uiX;
USHORT uiCoords[ 4 ];
void * pBuffer;
uiCoords[ 0 ] = ISNUM( 1 ) ? hb_parni( 1 ) : 0;
uiCoords[ 1 ] = ISNUM( 2 ) ? hb_parni( 2 ) : 0;
uiCoords[ 2 ] = ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow();
uiCoords[ 3 ] = ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol();
hb_gtRectSize( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], &uiX );
pBuffer = hb_xgrab( uiX );
hb_gtSave( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], pBuffer );
hb_retclen( ( char * ) pBuffer, uiX );
hb_xfree( ( char * ) pBuffer );
}
HARBOUR HB_RESTSCREEN( void )
{
if( ISCHAR( 5 ) )
hb_gtRest( ISNUM( 1 ) ? hb_parni( 1 ) : 0,
ISNUM( 2 ) ? hb_parni( 2 ) : 0,
ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(),
ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol(),
( void * ) hb_parc( 5 ) );
}

72
harbour/source/rtl/seconds.c Normal file
View File

@@ -0,0 +1,72 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SECONDS() function
*
* Copyright 1999 Jose Lalin <dezac@corevia.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include <time.h>
#if defined( OS_UNIX_COMPATIBLE )
#include <sys/timeb.h>
#else
#include <sys\timeb.h>
#endif
#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__)
#include <dos.h>
#endif
double hb_secondsToday( void )
{
#if defined(_MSC_VER)
#define timeb _timeb
#define ftime _ftime
#endif
struct timeb tb;
struct tm * oTime;
HB_TRACE(HB_TR_DEBUG, ("hb_secondsToday()"));
ftime( &tb );
oTime = localtime( &tb.time );
return ( oTime->tm_hour * 3600 ) +
( oTime->tm_min * 60 ) +
oTime->tm_sec +
( ( double ) tb.millitm / 1000 );
}
HARBOUR HB_SECONDS( void )
{
hb_retnd( hb_secondsToday() );
}

50
harbour/source/rtl/set.c
View File

@@ -33,17 +33,6 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Jose Lalin <dezac@corevia.com>
* HB_DEFPATH() and HB___DEFPATH()
*
* See doc/license.txt for licensing terms.
*
*/
/*
* ChangeLog:
*
@@ -191,6 +180,7 @@
*/
#include <ctype.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
@@ -853,41 +843,3 @@ void hb_setRelease( void )
hb_set.HB_SET_TYPEAHEAD = -1; hb_inkeyReset( TRUE ); /* Free keyboard typeahead buffer */
}
HARBOUR HB_DEFPATH( void )
{
char buffer[ _POSIX_PATH_MAX ];
char delimiter[ 2 ] = ":";
int size = 0;
if( hb_set.HB_SET_DEFAULT )
{
/* Leave enough space to append a path delimiter */
strncpy( buffer, hb_set.HB_SET_DEFAULT, sizeof( buffer ) - 1 );
size = sizeof( buffer ) - 2;
}
buffer[ size ] = '\0';
size = strlen( buffer );
HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: buffer is |%s|, size is %d, last char is |%c|", buffer, size, buffer[ size - 1]));
HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: OS_PATH_DELIMITER is |%c| and OS_PATH_LIST_SEPARATOR is |%c|", OS_PATH_DELIMITER, OS_PATH_LIST_SEPARATOR));
/* If the path is not empty and it doesn't end with a drive or path
delimiter, then add the appropriate separator. Use ':' if the size
of the path is 1 and the list separator is not ':', otherwise use
the path delimiter. This allows the use of a drive letter delimiter
for DOS compatible operating systems while preventing it from being
with a Unix compatible OS. */
if( size && buffer[ size - 1 ] != ':' && buffer[ size - 1 ] != OS_PATH_DELIMITER )
{
if( size > 1 || OS_PATH_LIST_SEPARATOR == ':' )
delimiter[ 0 ] = OS_PATH_DELIMITER;
strcat( buffer, delimiter );
}
hb_retc( buffer );
}
HARBOUR HB___DEFPATH( void )
{
HB_DEFPATH();
}

12
harbour/source/rtl/setcolor.c
View File

@@ -59,3 +59,15 @@ HARBOUR HB_COLORSELECT( void )
if( ISNUM( 1 ) )
hb_gtColorSelect( hb_parni( 1 ) );
}
HARBOUR HB_SETBLINK( void )
{
BOOL bPreviousBlink;
hb_gtGetBlink( &bPreviousBlink );
if( ISLOG( 1 ) )
hb_gtSetBlink( hb_parl( 1 ) );
hb_retl( bPreviousBlink );
}

55
harbour/source/rtl/setcurs.c Normal file
View File

@@ -0,0 +1,55 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SETCURSOR() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapigt.h"
USHORT hb_setCursor( BOOL bSetCursor, USHORT usNewCursor )
{
USHORT usPreviousCursor;
HB_TRACE(HB_TR_DEBUG, ("hb_setCursor(%d, %hu)", (int) bSetCursor, usNewCursor));
hb_gtGetCursor( &usPreviousCursor );
if( bSetCursor )
hb_gtSetCursor( usNewCursor );
return usPreviousCursor;
}
HARBOUR HB_SETCURSOR( void )
{
hb_retni( hb_setCursor( ISNUM( 1 ), hb_parni( 1 ) ) );
}

88
harbour/source/rtl/setpos.c Normal file
View File

@@ -0,0 +1,88 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SETPOS(), SETPOSBS() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* HB_SETPOS()
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* HB_SETPOSBS()
*
* See doc/license.txt for licensing terms.
*
*/
#include "hbapi.h"
#include "hbapigt.h"
HARBOUR HB_SETPOS( void ) /* Sets the screen position */
{
if( ISNUM( 1 ) && ISNUM( 2 ) )
hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) );
}
/* Move the screen position to the right by one column */
HARBOUR HB_SETPOSBS( void )
{
SHORT iRow, iCol;
/* NOTE: Clipper does no checks about reaching the border or anything.
[vszakats] */
hb_gtGetPos( &iRow, &iCol );
hb_gtSetPos( iRow, iCol + 1 );
}
HARBOUR HB_ROW( void ) /* Return the current screen row position (zero origin) */
{
SHORT iRow;
SHORT iCol;
hb_gtGetPos( &iRow, &iCol );
hb_retni( iRow );
}
HARBOUR HB_COL( void ) /* Return the current screen column position (zero origin) */
{
SHORT iRow;
SHORT iCol;
hb_gtGetPos( &iRow, &iCol );
hb_retni( iCol );
}

53
harbour/source/rtl/shadow.c Normal file
View File

@@ -0,0 +1,53 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HB_SHADOW(), DBGSHADOW() functions
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapigt.h"
HARBOUR HB_HB_SHADOW( void )
{
if( hb_pcount() >= 4 )
hb_gtDrawShadow( hb_parni( 1 ),
hb_parni( 2 ),
hb_parni( 3 ),
hb_parni( 4 ),
ISNUM( 5 ) ? hb_parni( 5 ) : 7 );
}
HARBOUR HB_DBGSHADOW( void )
{
HB_HB_SHADOW();
}

74
harbour/source/rtl/space.c Normal file
View File

@@ -0,0 +1,74 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SPACE() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns n copies of a single space */
/* TEST: QOUT( "space( 5 ) = '" + space( 5 ) + "'" ) */
HARBOUR HB_SPACE( void )
{
if( ISNUM( 1 ) )
{
long lLen = hb_parnl( 1 );
if( lLen > 0 )
{
char * szResult = ( char * ) hb_xgrab( lLen + 1 );
/* NOTE: String overflow could never occure since a string can
be as large as ULONG_MAX, and the maximum length that
can be specified is LONG_MAX here. [vszakats] */
/* hb_errRT_BASE( EG_STROVERFLOW, 1233, NULL, "SPACE" ); */
hb_xmemset( szResult, ' ', lLen );
hb_retclen( szResult, lLen );
hb_xfree( szResult );
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1105, NULL, "SPACE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

99
harbour/source/rtl/str.c Normal file
View File

@@ -0,0 +1,99 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* STR() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns the numeric value of a character string representation of a number */
double hb_strVal( const char * szText )
{
HB_TRACE(HB_TR_DEBUG, ("hb_strVal(%s)", szText));
return atof( szText );
}
HARBOUR HB_STR( void )
{
BOOL bValid;
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
PHB_ITEM pWidth = NULL;
PHB_ITEM pDec = NULL;
if( pNumber )
{
bValid = TRUE;
if( hb_pcount() >= 2 )
{
pWidth = hb_param( 2, IT_NUMERIC );
if( !pWidth )
bValid = FALSE;
}
if( hb_pcount() >= 3 )
{
pDec = hb_param( 3, IT_NUMERIC );
if( !pDec )
bValid = FALSE;
}
}
else
bValid = FALSE;
if( bValid )
{
char * szResult = hb_itemStr( pNumber, pWidth, pDec );
if( szResult )
{
hb_retc( szResult );
hb_xfree( szResult );
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

133
harbour/source/rtl/strcase.c Normal file
View File

@@ -0,0 +1,133 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Uppercase/lowercase string functions
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include <ctype.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* converts szText to lower case. Does not create a new string! */
char * hb_strLower( char * szText, ULONG ulLen )
{
ULONG i;
HB_TRACE(HB_TR_DEBUG, ("hb_strLower(%s, %lu)", szText, ulLen));
for( i = 0; i < ulLen; i++ )
szText[ i ] = tolower( szText[ i ] );
return szText;
}
/* converts szText to upper case. Does not create a new string! */
char * hb_strUpper( char * szText, ULONG ulLen )
{
ULONG i;
HB_TRACE(HB_TR_DEBUG, ("hb_strUpper(%s, %lu)", szText, ulLen));
for( i = 0; i < ulLen; i++ )
szText[ i ] = toupper( szText[ i ] );
return szText;
}
/* This function copies and converts szText to upper case.
*/
char * hb_strncpyUpper( char * pDest, const char * pSource, ULONG ulLen )
{
char * pStart = pDest;
HB_TRACE(HB_TR_DEBUG, ("hb_strncpyUpper(%p, %s, %lu)", pDest, pSource, ulLen));
pDest[ ulLen ] ='\0';
while( ulLen-- )
*pDest++ = toupper( *pSource++ );
return pStart;
}
/* converts string to lower case */
HARBOUR HB_LOWER( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
hb_retclen( hb_strLower( pszBuffer, ulLen ), ulLen );
hb_itemFreeC( pszBuffer );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1103, NULL, "LOWER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* converts string to upper case */
HARBOUR HB_UPPER( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
char * pszBuffer = hb_itemGetC( pText );
ULONG ulLen = hb_itemGetCLen( pText );
hb_retclen( hb_strUpper( pszBuffer, ulLen ), ulLen );
hb_itemFreeC( pszBuffer );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1102, NULL, "UPPER" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

1229
harbour/source/rtl/strings.c
View File

File diff suppressed because it is too large Load Diff

75
harbour/source/rtl/stris.c Normal file
View File

@@ -0,0 +1,75 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* IS*() string functions
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include <ctype.h>
#include "hbapi.h"
/* determines if first char of string is letter */
/* TEST: QOUT( "isalpha( 'hello' ) = ", isalpha( 'hello' ) ) */
/* TEST: QOUT( "isalpha( '12345' ) = ", isalpha( '12345' ) ) */
HARBOUR HB_ISALPHA( void )
{
hb_retl( isalpha( *hb_parc( 1 ) ) );
}
/* determines if first char of string is digit */
/* TEST: QOUT( "isdigit( '12345' ) = ", isdigit( '12345' ) ) */
/* TEST: QOUT( "isdigit( 'abcde' ) = ", isdigit( 'abcde' ) ) */
HARBOUR HB_ISDIGIT( void )
{
hb_retl( isdigit( *hb_parc( 1 ) ) );
}
/* determines if first char of string is upper-case */
/* TEST: QOUT( "isupper( 'Abcde' ) = ", isupper( 'Abcde' ) ) */
/* TEST: QOUT( "isupper( 'abcde' ) = ", isupper( 'abcde' ) ) */
HARBOUR HB_ISUPPER( void )
{
hb_retl( isupper( *hb_parc( 1 ) ) );
}
/* determines if first char of string is lower-case */
/* TEST: QOUT( "islower( 'abcde' ) = ", islower( 'abcde' ) ) */
/* TEST: QOUT( "islower( 'Abcde' ) = ", islower( 'Abcde' ) ) */
HARBOUR HB_ISLOWER( void )
{
hb_retl( islower( *hb_parc( 1 ) ) );
}

94
harbour/source/rtl/strmatch.c Normal file
View File

@@ -0,0 +1,94 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* String matching functions
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include <ctype.h>
#include "hbapi.h"
static BOOL hb_strMatchDOS( const char * pszString, const char * pszMask )
{
HB_TRACE(HB_TR_DEBUG, ("hb_strMatchDOS(%s, %s)", pszString, pszMask));
while( *pszMask && *pszString )
{
if( *pszMask == '*' )
{
while( *pszMask == '*' )
pszMask++;
if( ! ( *pszMask ) )
return TRUE;
else
if( *pszMask == '?' )
pszString++;
else
{
while( toupper( *pszString ) != toupper( *pszMask ) )
{
if( ! ( *( ++pszString ) ) )
return FALSE;
}
while( toupper( *pszString ) == toupper( *pszMask ) )
{
if( ! ( *( ++pszString ) ) )
break;
}
pszMask++;
}
}
else
if( toupper( *pszMask ) != toupper( *pszString ) && *pszMask != '?' )
return FALSE;
else
{
pszMask++;
pszString++;
}
}
return ! ( ( ! ( *pszString ) && *pszMask && *pszMask != '*') ||
( ! ( *pszMask ) && *pszString ) );
}
/* TODO: Replace it with a code that supports real regular expressions
*
*/
BOOL hb_strMatchRegExp( const char * szString, const char * szMask )
{
HB_TRACE(HB_TR_DEBUG, ("hb_strMatchRegExp(%s, %s)", szString, szMask));
return hb_strMatchDOS( szString, szMask );
}

197
harbour/source/rtl/strtran.c Normal file
View File

@@ -0,0 +1,197 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* STRTRAN function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* TOFIX: Check for string overflow, Clipper can crash if the resulting
string is too large. Example:
StrTran( "...", ".", Replicate( "A", 32000 ) ) [vszakats] */
/* replaces lots of characters in a string */
/* TOFIX: Will not work with a search string of > 64 KB on some platforms */
HARBOUR HB_STRTRAN( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
PHB_ITEM pSeek = hb_param( 2, IT_STRING );
if( pSeek )
{
char * szText = hb_itemGetCPtr( pText );
ULONG ulText = hb_itemGetCLen( pText );
ULONG ulSeek = hb_itemGetCLen( pSeek );
if( ulSeek && ulSeek <= ulText )
{
char * szSeek = hb_itemGetCPtr( pSeek );
char * szReplace;
ULONG ulStart;
ulStart = ( ISNUM( 4 ) ? hb_parnl( 4 ) : 1 );
if( !ulStart )
{
/* Clipper seems to work this way */
hb_retc( "" );
}
else if( ulStart > 0 )
{
PHB_ITEM pReplace = hb_param( 3, IT_STRING );
ULONG ulReplace;
ULONG ulCount;
BOOL bAll;
if( pReplace )
{
szReplace = hb_itemGetCPtr( pReplace );
ulReplace = hb_itemGetCLen( pReplace );
}
else
{
szReplace = ""; /* shouldn't matter that we don't allocate */
ulReplace = 0;
}
if( ISNUM( 5 ) )
{
ulCount = hb_parnl( 5 );
bAll = FALSE;
}
else
{
ulCount = 0;
bAll = TRUE;
}
if( bAll || ulCount > 0 )
{
ULONG ulFound = 0;
long lReplaced = 0;
ULONG i = 0;
ULONG ulLength = ulText;
while( i < ulText )
{
if( ( bAll || lReplaced < ( long ) ulCount ) && ! memcmp( szText + i, szSeek, ulSeek ) )
{
ulFound++;
if( ulFound >= ulStart )
{
lReplaced++;
ulLength = ulLength - ulSeek + ulReplace;
i += ulSeek;
}
else
i++;
}
else
i++;
}
if( ulFound )
{
char * szResult = ( char * ) hb_xgrab( ulLength + 1 );
char * szPtr = szResult;
ulFound = 0;
i = 0;
while( i < ulText )
{
if( lReplaced && ! memcmp( szText + i, szSeek, ulSeek ) )
{
ulFound++;
if( ulFound >= ulStart )
{
lReplaced--;
memcpy( szPtr, szReplace, ulReplace );
szPtr += ulReplace;
i += ulSeek;
}
else
{
*szPtr = szText[ i ];
szPtr++;
i++;
}
}
else
{
*szPtr = szText[ i ];
szPtr++;
i++;
}
}
hb_retclen( szResult, ulLength );
hb_xfree( szResult );
}
else
hb_retclen( szText, ulText );
}
else
hb_retclen( szText, ulText );
}
else
hb_retclen( szText, ulText );
}
else
hb_retclen( szText, ulText );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

127
harbour/source/rtl/strzero.c Normal file
View File

@@ -0,0 +1,127 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* STRZERO() function
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
HARBOUR HB_STRZERO( void )
{
if( hb_pcount() >= 1 && hb_pcount() <= 3 )
{
BOOL bValid;
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
PHB_ITEM pWidth = NULL;
PHB_ITEM pDec = NULL;
if( pNumber )
{
bValid = TRUE;
if( hb_pcount() >= 2 )
{
pWidth = hb_param( 2, IT_NUMERIC );
if( !pWidth )
bValid = FALSE;
}
if( hb_pcount() >= 3 )
{
pDec = hb_param( 3, IT_NUMERIC );
if( !pDec )
bValid = FALSE;
}
}
else
bValid = FALSE;
if( bValid )
{
char * szResult = hb_itemStr( pNumber, pWidth, pDec );
if( szResult )
{
ULONG ulPos = 0;
while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] != '-' )
ulPos++;
if( szResult[ ulPos ] == '-' )
{
/* Negative sign found, put the negative sign to the first */
/* position */
szResult[ ulPos ] = ' ';
ulPos = 0;
while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' )
szResult[ ulPos++ ] = '0';
szResult[ 0 ] = '-';
}
else
{
/* Negative sign not found */
ulPos = 0;
while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' )
szResult[ ulPos++ ] = '0';
}
hb_retc( szResult );
hb_xfree( szResult );
}
else
hb_retc( "" );
}
else
{
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
/* NOTE: In CA-Cl*pper STRZERO() is written in Clipper, and will call
STR() to do the job, the error (if any) will also be thrown
by STR(). [vszakats] */
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" );
#else
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 9999, NULL, "STRZERO" );
#endif
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
}

79
harbour/source/rtl/stuff.c Normal file
View File

@@ -0,0 +1,79 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* STUFF() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
/* replaces characters in a string */
HARBOUR HB_STUFF( void )
{
if( ISCHAR( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISCHAR( 4 ) )
{
char * szText = hb_parc( 1 );
ULONG ulText = hb_parclen( 1 );
ULONG ulPos = hb_parnl( 2 );
ULONG ulDel = hb_parnl( 3 );
ULONG ulInsert = hb_parclen( 4 );
ULONG ulTotalLen;
if( ulPos > 0 )
ulPos--;
if( ulPos > ulText )
ulPos = ulText;
if( ulDel > ulText - ulPos )
ulDel = ulText - ulPos;
if( ( ulTotalLen = ulText + ulInsert - ulDel ) > 0 )
{
char * szResult = ( char * ) hb_xgrab( ulTotalLen + 1 );
hb_xmemcpy( szResult, szText, ulPos );
hb_xmemcpy( szResult + ulPos, hb_parc( 4 ), ulInsert );
hb_xmemcpy( szResult + ulPos + ulInsert, szText + ulPos + ulDel, ulText - ( ulPos + ulDel ) );
szResult[ ulTotalLen ] = '\0';
hb_retclen( szResult, ulTotalLen );
hb_xfree( szResult );
}
else
hb_retc( "" );
}
else
hb_retc( "" );
}

109
harbour/source/rtl/substr.c Normal file
View File

@@ -0,0 +1,109 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* LEFT() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns l characters from n characters into string */
HARBOUR HB_SUBSTR( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText && ISNUM( 2 ) )
{
long lPos = hb_parnl( 2 );
if( lPos < 0 )
{
lPos += ( long ) hb_itemGetCLen( pText );
if( lPos < 0 )
lPos = 0;
}
else if( lPos )
{
lPos--;
}
if( lPos < ( long ) hb_itemGetCLen( pText ) )
{
long lLen;
if( hb_pcount() >= 3 )
{
if( ISNUM( 3 ) )
{
lLen = hb_parnl( 3 );
if( lLen > ( long ) hb_itemGetCLen( pText ) - lPos )
lLen = ( long ) hb_itemGetCLen( pText ) - lPos;
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
/* NOTE: Exit from inside [vszakats] */
return;
}
}
else
lLen = ( long ) hb_itemGetCLen( pText ) - lPos;
if( lLen > 0 )
hb_retclen( hb_itemGetCPtr( pText ) + lPos, lLen );
else
hb_retc( "" );
}
else
hb_retc( "" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

167
harbour/source/rtl/trim.c Normal file
View File

@@ -0,0 +1,167 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* *TRIM() functions
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* trims from the left, and returns a new pointer to szText */
/* also returns the new length in lLen */
char * hb_strLTrim( const char * szText, ULONG * ulLen )
{
HB_TRACE(HB_TR_DEBUG, ("hb_strLTrim(%s, %p)", szText, ulLen));
while( *ulLen && HB_ISSPACE( *szText ) )
{
szText++;
( *ulLen )--;
}
return ( char * ) szText;
}
/* returns szText and the new length in lLen */
ULONG hb_strRTrimLen( const char * szText, ULONG ulLen, BOOL bAnySpace )
{
HB_TRACE(HB_TR_DEBUG, ("hb_strRTrimLen(%s, %lu. %d)", szText, ulLen, (int) bAnySpace));
if( bAnySpace )
{
while( ulLen && HB_ISSPACE( szText[ ulLen - 1 ] ) )
ulLen--;
}
else
{
while( ulLen && szText[ ulLen - 1 ] == ' ' )
ulLen--;
}
return ulLen;
}
/* trims leading spaces from a string */
/* TEST: QOUT( "ltrim( ' hello world ' ) = '" + ltrim( ' hello world ' ) + "'" ) */
HARBOUR HB_LTRIM( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
ULONG ulLen = hb_itemGetCLen( pText );
char * szText = hb_strLTrim( hb_itemGetCPtr( pText ), &ulLen );
hb_retclen( szText, ulLen );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1101, NULL, "LTRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: The second parameter is a Harbour extension [vszakats] */
/* trims trailing spaces from a string */
/* TEST: QOUT( "rtrim( ' hello world ' ) = '" + rtrim( ' hello world ' ) + "'" ) */
HARBOUR HB_RTRIM( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
char * pszText = hb_itemGetCPtr( pText );
BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE );
hb_retclen( pszText, hb_strRTrimLen( pszText, hb_itemGetCLen( pText ), bAnySpace ) );
}
else
{
/* NOTE: "TRIM" is right here [vszakats] */
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1100, NULL, "TRIM" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: The second parameter is a Harbour extension [vszakats] */
/* synonymn for RTRIM */
HARBOUR HB_TRIM( void )
{
HB_RTRIM();
}
/* NOTE: The second parameter is a Harbour extension [vszakats] */
/* trims leading and trailing spaces from a string */
/* TEST: QOUT( "alltrim( ' hello world ' ) = '" + alltrim( ' hello world ' ) + "'" ) */
HARBOUR HB_ALLTRIM( void )
{
if( ISCHAR( 1 ) )
{
char * szText = hb_parc( 1 );
BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE );
ULONG ulLen = hb_strRTrimLen( szText, hb_parclen( 1 ), bAnySpace );
szText = hb_strLTrim( szText, &ulLen );
hb_retclen( szText, ulLen );
}
else
#ifdef HB_COMPAT_C53
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 2022, NULL, "ALLTRIM" ); /* NOTE: This appeared in CA-Cl*pper 5.3 [vszakats] */
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
#else
hb_retc( "" );
#endif
}

75
harbour/source/rtl/val.c Normal file
View File

@@ -0,0 +1,75 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* VAL() function
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
/* returns the numeric value of a character string representation of a number */
HARBOUR HB_VAL( void )
{
PHB_ITEM pText = hb_param( 1, IT_STRING );
if( pText )
{
int iWidth;
int iDec;
char * ptr = strchr( hb_itemGetCPtr( pText ), '.' );
if( ptr )
{
iWidth = ptr - hb_itemGetCPtr( pText );
iDec = strlen( ptr + 1 );
}
else
{
iWidth = strlen( hb_itemGetCPtr( pText ) );
iDec = 0;
}
hb_retndlen( hb_strVal( hb_itemGetCPtr( pText ) ), iWidth, iDec );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1098, NULL, "VAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

50
harbour/source/rtl/valtostr.c Normal file
View File

@@ -0,0 +1,50 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HB_VALTOSTR() function
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
HARBOUR HB_HB_VALTOSTR( void )
{
ULONG ulLen;
BOOL bFreeReq;
char * buffer = hb_itemString( hb_param( 1, IT_ANY ), &ulLen, &bFreeReq );
hb_retclen( buffer, ulLen );
if( bFreeReq )
hb_xfree( buffer );
}

1
harbour/source/vm/Makefile
View File

@@ -6,6 +6,7 @@ ROOT = ../../
C_SOURCES=\
arrays.c \
arrayshb.c \
break.c \
classes.c \
cmdarg.c \

246
harbour/source/vm/arrays.c
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* The Array API
* The Array API (C level)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
@@ -53,10 +53,6 @@
#include "hbapilng.h"
#include "hbvm.h"
/*
* Internal
*/
BOOL hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */
{
PHB_BASEARRAY pBaseArray = ( PHB_BASEARRAY ) hb_xgrab( sizeof( HB_BASEARRAY ) );
@@ -771,243 +767,3 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray )
return pDstArray;
}
/* This function creates an array item using 'iDimension' as an index
* to retrieve the number of elements from the parameter list.
*/
static void hb_arrayNewRagged( PHB_ITEM pArray, int iDimension )
{
ULONG ulElements;
HB_TRACE(HB_TR_DEBUG, ("hb_arrayNewRagged(%p, %d)", pArray, iDimension));
ulElements = ( ULONG ) hb_parnl( iDimension );
/* create an array */
hb_arrayNew( pArray, ulElements );
if( ++iDimension <= hb_pcount() )
{
/* call self recursively to create next dimensions
*/
while( ulElements )
hb_arrayNewRagged( hb_arrayGetItemPtr( pArray, ulElements-- ), iDimension );
}
}
/*
* HARBOUR
*/
HARBOUR HB_ARRAY( void )
{
int iPCount = hb_pcount();
if( iPCount > 0 )
{
BOOL bError = FALSE;
int iParam;
for( iParam = 1; iParam <= iPCount; iParam++ )
{
if( ! ISNUM( iParam ) )
{
bError = TRUE;
break;
}
if( hb_parnl( iParam ) < 0 ) /* || hb_parnl( iParam ) <= 4096 */
{
hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ) );
bError = TRUE;
break;
}
}
if( ! bError )
hb_arrayNewRagged( &hb_stack.Return, 1 );
}
}
HARBOUR HB_AADD( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pValue && hb_arrayAdd( pArray, pValue ) )
hb_itemReturn( pValue );
else
hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1123, NULL, "AADD" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: CA-Cl*pper 5.3 and older will return NIL on bad parameter, 5.3a,b
will throw a runtime error. [vszakats] */
HARBOUR HB_ASIZE( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray && ISNUM( 2 ) )
{
long lSize = hb_parnl( 2 );
hb_arraySize( pArray, HB_MAX_( lSize, 0 ) );
hb_itemReturn( pArray ); /* ASize() returns the array itself */
}
#ifdef HB_COMPAT_C53 /* From CA-Cl*pper 5.3a */
else
hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE" );
#endif
}
HARBOUR HB_ATAIL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
hb_arrayLast( pArray, &hb_stack.Return );
}
HARBOUR HB_AINS( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
if( ISNUM( 2 ) )
hb_arrayIns( pArray, hb_parnl( 2 ) );
hb_itemReturn( pArray ); /* AIns() returns the array itself */
}
}
HARBOUR HB_ADEL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
if( ISNUM( 2 ) )
hb_arrayDel( pArray, hb_parnl( 2 ) );
hb_itemReturn( pArray ); /* ADel() returns the array itself */
}
}
HARBOUR HB_AFILL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pValue )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
hb_arrayFill( pArray,
pValue,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL );
}
hb_itemReturn( pArray ); /* AFill() returns the array itself */
}
}
HARBOUR HB_ASCAN( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pArray && pValue )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
hb_retnl( hb_arrayScan( pArray,
pValue,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL ) );
}
else
hb_retnl( 0 );
}
HARBOUR HB_AEVAL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pBlock = hb_param( 2, IT_BLOCK );
if( pArray && pBlock )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
hb_arrayEval( pArray,
pBlock,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL );
hb_itemReturn( pArray ); /* AEval() returns the array itself */
}
else
hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" );
}
HARBOUR HB_ACOPY( void )
{
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY );
if( pSrcArray && pDstArray )
{
/* CA-Cl*pper works this way. */
if( ! hb_arrayIsObject( pSrcArray ) && ! hb_arrayIsObject( pDstArray ) )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
ULONG ulTarget = hb_parnl( 5 );
hb_arrayCopy( pSrcArray,
pDstArray,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL,
ISNUM( 5 ) ? &ulTarget : NULL );
}
hb_itemReturn( pDstArray ); /* ACopy() returns the target array */
}
}
/* NOTE: Clipper will return NIL if the parameter is not an array. [vszakats] */
HARBOUR HB_ACLONE( void )
{
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
if( pSrcArray && ! hb_arrayIsObject( pSrcArray ) )
{
PHB_ITEM pDstArray = hb_arrayClone( pSrcArray );
hb_itemReturn( pDstArray ); /* AClone() returns the new array */
hb_itemRelease( pDstArray );
}
}

276
harbour/source/vm/arrayshb.c Normal file
View File

@@ -0,0 +1,276 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Array API (Harbour level)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbapilng.h"
/* This function creates an array item using 'iDimension' as an index
* to retrieve the number of elements from the parameter list.
*/
static void hb_arrayNewRagged( PHB_ITEM pArray, int iDimension )
{
ULONG ulElements;
HB_TRACE(HB_TR_DEBUG, ("hb_arrayNewRagged(%p, %d)", pArray, iDimension));
ulElements = ( ULONG ) hb_parnl( iDimension );
/* create an array */
hb_arrayNew( pArray, ulElements );
if( ++iDimension <= hb_pcount() )
{
/* call self recursively to create next dimensions
*/
while( ulElements )
hb_arrayNewRagged( hb_arrayGetItemPtr( pArray, ulElements-- ), iDimension );
}
}
HARBOUR HB_ARRAY( void )
{
int iPCount = hb_pcount();
if( iPCount > 0 )
{
BOOL bError = FALSE;
int iParam;
for( iParam = 1; iParam <= iPCount; iParam++ )
{
if( ! ISNUM( iParam ) )
{
bError = TRUE;
break;
}
if( hb_parnl( iParam ) < 0 ) /* || hb_parnl( iParam ) <= 4096 */
{
hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ) );
bError = TRUE;
break;
}
}
if( ! bError )
hb_arrayNewRagged( &hb_stack.Return, 1 );
}
}
HARBOUR HB_AADD( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pValue && hb_arrayAdd( pArray, pValue ) )
hb_itemReturn( pValue );
else
hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1123, NULL, "AADD" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
/* NOTE: CA-Cl*pper 5.3 and older will return NIL on bad parameter, 5.3a,b
will throw a runtime error. [vszakats] */
HARBOUR HB_ASIZE( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray && ISNUM( 2 ) )
{
long lSize = hb_parnl( 2 );
hb_arraySize( pArray, HB_MAX_( lSize, 0 ) );
hb_itemReturn( pArray ); /* ASize() returns the array itself */
}
#ifdef HB_COMPAT_C53 /* From CA-Cl*pper 5.3a */
else
hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE" );
#endif
}
HARBOUR HB_ATAIL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
hb_arrayLast( pArray, &hb_stack.Return );
}
HARBOUR HB_AINS( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
if( ISNUM( 2 ) )
hb_arrayIns( pArray, hb_parnl( 2 ) );
hb_itemReturn( pArray ); /* AIns() returns the array itself */
}
}
HARBOUR HB_ADEL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
if( ISNUM( 2 ) )
hb_arrayDel( pArray, hb_parnl( 2 ) );
hb_itemReturn( pArray ); /* ADel() returns the array itself */
}
}
HARBOUR HB_AFILL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
if( pArray )
{
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pValue )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
hb_arrayFill( pArray,
pValue,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL );
}
hb_itemReturn( pArray ); /* AFill() returns the array itself */
}
}
HARBOUR HB_ASCAN( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pValue = hb_param( 2, IT_ANY );
if( pArray && pValue )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
hb_retnl( hb_arrayScan( pArray,
pValue,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL ) );
}
else
hb_retnl( 0 );
}
HARBOUR HB_AEVAL( void )
{
PHB_ITEM pArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pBlock = hb_param( 2, IT_BLOCK );
if( pArray && pBlock )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
hb_arrayEval( pArray,
pBlock,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL );
hb_itemReturn( pArray ); /* AEval() returns the array itself */
}
else
hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" );
}
HARBOUR HB_ACOPY( void )
{
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY );
if( pSrcArray && pDstArray )
{
/* CA-Cl*pper works this way. */
if( ! hb_arrayIsObject( pSrcArray ) && ! hb_arrayIsObject( pDstArray ) )
{
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
ULONG ulTarget = hb_parnl( 5 );
hb_arrayCopy( pSrcArray,
pDstArray,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL,
ISNUM( 5 ) ? &ulTarget : NULL );
}
hb_itemReturn( pDstArray ); /* ACopy() returns the target array */
}
}
/* NOTE: Clipper will return NIL if the parameter is not an array. [vszakats] */
HARBOUR HB_ACLONE( void )
{
PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY );
if( pSrcArray && ! hb_arrayIsObject( pSrcArray ) )
{
PHB_ITEM pDstArray = hb_arrayClone( pSrcArray );
hb_itemReturn( pDstArray ); /* AClone() returns the new array */
hb_itemRelease( pDstArray );
}
}

2
harbour/source/vm/maindll.c
View File

@@ -38,7 +38,7 @@
#include <windows.h>
#include "hbvm.h"
#if defined(__BORLAND__)
#if defined(__BORLANDC__)
BOOL WINAPI _export
#else
__declspec(dllexport) BOOL

2
harbour/utils/hbtest/hbtest.prg
View File

@@ -200,7 +200,7 @@ STATIC FUNCTION TEST_BEGIN( cParam )
FWrite( s_nFhnd, "---------------------------------------------------------------------------" + HB_OSNewLine() +;
" Version: " + Version( 0 ) + HB_OSNewLine() +;
" OS: " + OS() + HB_OSNewLine() +;
" Date, Time: " + DToS( Date() ) + " " + Time() + HB_OSNewLine() +;
" Date, Time: " + DToC( Date() ) + " " + Time() + HB_OSNewLine() +;
" Output: " + s_cFileName + HB_OSNewLine() +;
"Shortcut opt.: " + iif( s_lShortcut, "ON", "OFF" ) + HB_OSNewLine() +;
" Switches: " + cParam + HB_OSNewLine() +;