diff --git a/harbour/contrib/htmllib/Makefile b/harbour/contrib/htmllib/Makefile new file mode 100644 index 0000000000..eb70bb63ab --- /dev/null +++ b/harbour/contrib/htmllib/Makefile @@ -0,0 +1,25 @@ +# +# $Id$ +# + +ROOT = ../../ + +C_SOURCES=\ + +PRG_SOURCES=\ + ohtm.prg \ + ocgi.prg \ + oedit.prg \ + oframe.prg \ + oini.prg \ + ofile.prg \ + jwindow.prg \ + htmutil.prg \ + counter.prg \ + errorsys.prg \ + htmbrows.prg \ + jlist.prg \ + +LIBNAME=html + +include $(TOP)$(ROOT)config/lib.cf diff --git a/harbour/contrib/htmllib/Makefile.bc b/harbour/contrib/htmllib/Makefile.bc new file mode 100644 index 0000000000..d7caa4da81 --- /dev/null +++ b/harbour/contrib/htmllib/Makefile.bc @@ -0,0 +1,203 @@ +# +# $Id$ +# + +# +# Makefile for Harbour Project for Borland C/C++ 3.x, 4.x, 5.x compilers +# + +# +# NOTE: You can use these envvars to configure the make process: +# (note that these are all optional) +# +# CFLAGS - Extra C compiler options for libraries and for +# executables +# C_USR - Extra C compiler options for libraries and for +# executables (GNU make compatible envvar) +# CLIBFLAGS - Extra C compiler options for the libraries +# HARBOURFLAGS - Extra Harbour compiler options +# PRG_USR - Extra Harbour compiler options +# (GNU make compatible envvar) +# + +# +# NOTE: "echo." intentionally used instead of "echo", to avoid conflicts +# with external commands named echo. +# + +!if $d(B16) + +CC = bcc +AS = tasm + +# Borland C/C++ (DOS 16 bits) +CFLAGS = -mh $(CFLAGS) + +BIN_DIR = bin\b16 +OBJ_DIR = obj\b16 +LIB_DIR = lib\b16 + +!else + +CC = bcc32 +AS = tasm32 + +BIN_DIR = ..\..\bin\b32 +OBJ_DIR = ..\..\obj\b32 +LIB_DIR = ..\..\lib\b32 + +# This is needed, otherwise the libs may overflow when +# debug info is requested with -v -y +ARFLAGS = /P32 + +!endif + +!if !$d(BCC_NOOPTIM) +CFLAGS = -O2 $(CFLAGS) +!endif + +# +# Directory macros. These should never have to change. +# + +INCLUDE_DIR = ..\..\include;include +TOOLS_DIR = source +TOOLS1_DIR = examples +# +# C compiler definition and C flags. These should never have to change. +# + +CFLAGS = -I$(INCLUDE_DIR) -d $(C_USR) $(CFLAGS) +CLIBFLAGS = -c $(CFLAGS) $(CLIBFLAGS) +CLIBFLAGSDEBUG = -v $(CLIBFLAGS) +HARBOURFLAGS = -i$(INCLUDE_DIR) -n -w0 -gc0 $(PRG_USR) $(HARBOURFLAGS) -p +LDFLAGS = $(LDFLAGS) + +# +# Macros to access our library names +# + +TOOLS_LIB = $(LIB_DIR)\html.lib + +HARBOUR_EXE = $(BIN_DIR)\harbour.exe + +# +# Rules +# + +# +# TOOLS.LIB rules +# +TOOLS_LIB_OBJS = \ +$(OBJ_DIR)\ohtm.obj \ +$(OBJ_DIR)\htmbrows.obj \ +$(OBJ_DIR)\oedit.obj \ +$(OBJ_DIR)\ofile.obj \ +$(OBJ_DIR)\jlist.obj \ +$(OBJ_DIR)\oini.obj \ +$(OBJ_DIR)\jwindow.obj \ +$(OBJ_DIR)\ocgi.obj \ +$(OBJ_DIR)\oframe.obj \ +$(OBJ_DIR)\counter.obj \ +$(OBJ_DIR)\errorsys.obj \ +$(OBJ_DIR)\htmutil.obj + +# +# Our default target +# + +all: \ + $(TOOLS_LIB) \ + +# +# Library dependencies and build rules +# + +$(TOOLS_LIB) : $(TOOLS_LIB_OBJS) + + +$(OBJ_DIR)\ohtm.c : $(TOOLS_DIR)\ohtm.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\ohtm.obj : $(OBJ_DIR)\ohtm.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\htmbrows.c : $(TOOLS_DIR)\htmbrows.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\htmbrows.obj : $(OBJ_DIR)\htmbrows.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\oedit.c : $(TOOLS_DIR)\oedit.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\oedit.obj : $(OBJ_DIR)\oedit.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\ofile.c : $(TOOLS_DIR)\ofile.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\ofile.obj : $(OBJ_DIR)\ofile.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\jlist.c : $(TOOLS_DIR)\jlist.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\jlist.obj : $(OBJ_DIR)\jlist.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + + +$(OBJ_DIR)\oini.c : $(TOOLS_DIR)\oini.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\oini.obj : $(OBJ_DIR)\oini.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\jwindow.c : $(TOOLS_DIR)\jwindow.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\jwindow.obj : $(OBJ_DIR)\jwindow.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\ocgi.c : $(TOOLS_DIR)\ocgi.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\ocgi.obj : $(OBJ_DIR)\ocgi.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\oframe.c : $(TOOLS_DIR)\oframe.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\oframe.obj : $(OBJ_DIR)\oframe.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\counter.c : $(TOOLS1_DIR)\counter.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\counter.obj : $(OBJ_DIR)\counter.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\errorsys.c : $(TOOLS_DIR)\errorsys.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\errorsys.obj : $(OBJ_DIR)\errorsys.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\htmutil.c : $(TOOLS_DIR)\htmutil.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\htmutil.obj : $(OBJ_DIR)\htmutil.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + diff --git a/harbour/contrib/htmllib/colors.ch b/harbour/contrib/htmllib/colors.ch new file mode 100644 index 0000000000..cab39345ff --- /dev/null +++ b/harbour/contrib/htmllib/colors.ch @@ -0,0 +1,190 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Colors include file for HTMLLIB + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _COLORS_CH + +#define ALICEBLUE '#A0CF00' +#define ANTIQUEWHITE '#FFE8D0' +#define AQUA '#00FFFF' +#define AQUAMARINE '#7FFFD0' +#define AZURE '#F0FFFF' +#define BEIGE '#F0F7DF' +#define BISQUE '#FFE7C0' +#define BLACK '#000000' +#define BLANCHEDALMOND '#FFE8CF' +#define BLUE '#0000FF' +#define BLUEVIOLET '#8F28E0' +#define BROWN '#A0282F' +#define BURLYWOOD '#DFB880' +#define CADETBLUE '#5F9FA0' +#define CHARTREUSE '#7FFF00' +#define CHOCOLATE '#D0861F' +#define CORAL '#FF7F50' +#define CORNFLOWERBLUE '#6097EF' +#define CORNSILK '#FFF8DF' +#define CRIMSON '#DF173F' +#define CYAN '#00FFFF' +#define DARKBLUE '#00008F' +#define DARKCYAN '#00888F' +#define DARKGOLDENROD '#BF87F0' +#define DARKGRAY '#AFA8AF' +#define DARKGREEN '#006700' +#define DARKKHAKI '#BFB76F' +#define DARKMAGENTA '#8F008F' +#define DARKOLIVEGREEN '#50682F' +#define DARKORANGE '#FF8F00' +#define DARKORCHID '#9F30CF' +#define DARKRED '#8F0000' +#define DARKSALMON '#EF977F' +#define DARKSEAGREEN '#8FBF8F' +#define DARKSLATEBLUE '#4F3F8F' +#define DARKSLATEGRAY '#2F4F4F' +#define DARKTURQUOISE '#00CFD0' +#define DARKVIOLET '#9000D0' +#define DEEPPINK '#FF1790' +#define DEEPSKYBLUE '#00BFFF' +#define DIMGRAY '#6F686F' +#define DODGERBLUE '#1F90FF' +#define FIREBRICK '#B02020' +#define FLORALWHITE '#FFF8F0' +#define FORESTGREEN '#208820' +#define FUCHSIA '#FF00FF' +#define GAINSBORO '#DFDFDF' +#define GHOSTWHITE '#FFF8FF' +#define GOLD '#FFD700' +#define GOLDENROD '#DFA720' +#define GRAY '#808080' +#define GREEN '#008000' +#define GREENYELLOW '#AFFF2F' +#define HONEYDEW '#F0FFF0' +#define HOTPINK '#FF68B0' +#define INDIANRED '#CF5F5F' +#define INDIGO '#4F0080' +#define IVORY '#FFFFF0' +#define KHAKI '#F0E78F' +#define LAVENDER '#E0E7FF' +#define LAVENDERBLUSH '#FFF0F0' +#define LAWNGREEN '#7FFF00' +#define LEMONCHIFFON '#FFF8CF' +#define LIGHTBLUE '#AFD8E0' +#define LIGHTCORAL '#F08080' +#define LIGHTCYAN '#E0FFFF' +#define LIGHTGOLDENRODYELLOW '#FFF8D0' +#define LIGHTGREEN '#90EF90' +#define LIGHTGREY '#D0D0D0' +#define LIGHTPINK '#FFB7C0' +#define LIGHTSALMON '#FFA07F' +#define LIGHTSEAGREEN '#20B0AF' +#define LIGHTSKYBLUE '#80CFFF' +#define LIGHTSLATEGRAY '#70889F' +#define LIGHTSTEELBLUE '#B0C7DF' +#define LIGHTYELLOW '#FFFFE0' +#define LIME '#00FF00' +#define LIMEGREEN '#30CF30' +#define LINEN '#FFF0E0' +#define MAGENTA '#FF00FF' +#define MAROON '#800000' +#define MEDIUMAQUAMARINE '#60CFAF' +#define MEDIUMBLUE '#0000CF' +#define MEDIUMORCHID '#BF57D0' +#define MEDIUMPURPLE '#9070DF' +#define MEDIUMSEAGREEN '#3FB070' +#define MEDIUMSLATEBLUE '#7F68EF' +#define MEDIUMSPRINGGREEN '#00F89F' +#define MEDIUMTURQUOISE '#4FD0CF' +#define MEDIUMVIOLETRED '#C01780' +#define MIDNIGHTBLUE '#1F1870' +#define MINTCREAM '#F0FFFF' +#define MISTYROSE '#FFE7E0' +#define MOCCASIN '#FFE7B0' +#define NAVAJOWHITE '#FFDFAF' +#define NAVY '#000080' +#define OLDLACE '#FFF7E0' +#define OLIVE '#808000' +#define OLIVEDRAB '#6F8F20' +#define ORANGE '#FFA700' +#define ORANGERED '#FF4700' +#define ORCHID '#DF70D0' +#define PALEGOLDENROD '#EFE8AF' +#define PALEGREEN '#9FF89F' +#define PALETURQUOISE '#AFEFEF' +#define PALEVIOLETRED '#DF7090' +#define PAPAYAWHIP '#FFEFD0' +#define PEACHPUFF '#FFD8BF' +#define PERU '#CF873F' +#define PINK '#FFC0CF' +#define PLUM '#DFA1DF' +#define POWDERBLUE '#B0E0E0' +#define PURPLE '#800080' +#define RED '#FF0000' +#define ROSYBROWN '#BF8F8F' +#define ROYALBLUE '#4068E0' +#define SADDLEBROWN '#8F4710' +#define SALMON '#FF8070' +#define SANDYBROWN '#F0A760' +#define SEAGREEN '#2F8850' +#define SEASHELL '#FFF7EF' +#define SIENNA '#A0502F' +#define SILVER '#C0C0C0' +#define SKYBLUE '#80CFEF' +#define SLATEBLUE '#6F58CF' +#define SLATEGRAY '#708090' +#define SNOW '#FFF8FF' +#define SPRINGGREEN '#00FF7F' +#define STEELBLUE '#4080B0' +#define TAN '#D0B78F' +#define TEAL '#008080' +#define THISTLE '#DFBFDF' +#define TOMATO '#FF6040' +#define TURQUOISE '#40E0D0' +#define VIOLET '#EF80EF' +#define WHEAT '#F0DFB0' +#define WHITE '#FFFFFF' +#define WHITESMOKE '#F0F7F0' +#define YELLOW '#FFFF00' +#define YELLOWGREEN '#9FCF30' + +#define _COLORS_CH +#endif diff --git a/harbour/contrib/htmllib/counter.prg b/harbour/contrib/htmllib/counter.prg new file mode 100644 index 0000000000..cd7a7888b3 --- /dev/null +++ b/harbour/contrib/htmllib/counter.prg @@ -0,0 +1,88 @@ +#include "html.ch" +#include "forms.ch" +#include "default.ch" + + + +PROC CounterCGI() +LOCAL lIsPost := .F. +LOCAL cCounterDat := "counter.dat" +LOCAL oFrm, oEd, oSub + +LOCAL oHtm, oCgi + +SET DATE BRITISH + +IF "POST" $ UPPER(GETENV("REQUEST_METHOD")) + lIsPost := .T. + oCgi := oCGI():New() // get server parameters/variables +ENDIF + +oHtm := HTML():CGINew( "Counter.htm", "My Counter File" ) + +oHtm:SetPageColor(CLR_DARK_YELLOW ) //"#FFFFCC") +oHtm:SetTextColor(CLR_WHITE) +oHtm:SetbgImage("/images/back/bg32.bmp") +oHtm:Setcenter( .f. ) +oHtm:qout( "" ) +SET FONT "Verdana" SIZE 3 OF oHtm + +DEFINE FORM oFrm ; + CAPTION "A Simple Counter" ; + NAME "MyForm"; + ACTION "/cgi-bin/counter.exe?" ; + FRAME + +CONTROL EDIT NAME "User" ; + MAXCHARS 20 ; + SIZE 20 ; + CAPTION "User Name:" ; + IN oFrm + +LINE BREAK IN oFrm +LINE IN oFrm +LINE BREAK IN oFrm +SPACE 80 IN oFrm + +CONTROL SUBMIT NAME cSubmit VALUE (" Ok ") IN oFrm + +ACTIVATE oFrm + +SET FONT "Verdana" SIZE 3 OF oHtm +oHtm:defineTable( 2,, 90,, "#9196A0" ) +oHtm:newTableRow() +oHtm:newTableCell() +oHtm:QOut( "Page Visited :" + TRANSFORM( incCounter(), "999,999,999" ) + +htmlSpace(2)+"Times") +oHtm:EndTableCell() +oHtm:EndTableRow() +oHtm:EndTable() + +oHtm:cgiClose() +RETURN + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +FUNCTION IncCounter() +LOCAL n := 0 + +IF FILE("Counter.dat") + n := VAL(MEMOREAD("counter.dat")) +ELSE + n := 0 +ENDIF +MEMOWRIT( "counter.dat", STR( n+1 ) ) +RETURN n + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + FUNCTION GetCounter() +LOCAL n := 0 + +IF FILE("Counter.dat") + n := VAL(MEMOREAD("counter.dat")) +ELSE + incCounter() +ENDIF +RETURN n + + diff --git a/harbour/contrib/htmllib/default.ch b/harbour/contrib/htmllib/default.ch new file mode 100644 index 0000000000..437f79938c --- /dev/null +++ b/harbour/contrib/htmllib/default.ch @@ -0,0 +1,274 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * DEFAULT.CH some default definition to HTMLLIB + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _DEFAULT_CH_ + +//#ifndef _BOX_CH +//#include "box.ch" +//#endif + +#ifndef _INKEY_CH +#include "inkey.ch" +#endif + +#ifndef _COMMON_CH +#include "common.ch" +#endif + +#xTranslate PERCENT( , ) => ; + ( ( * ) / 100 ) + +// --> Default parameters +#xcommand DEFAULT := ; + [, := ] => ; + := IIf( == nil, , ) ;; + [ := IIf( == nil, , ); ] + +#xcommand DEFAULT TO [, TO ] ; + => ; + IF == NIL ; := ; END ; + [; IF == NIL ; := ; END ] + +// --> OOPs +#xtranslate BYNAME [, ] => :: := [; :: := ] +#xtranslate BYNAME DEFAULT => :: := BYDEFAULT , +#xtranslate BYDEFAULT , => IIF( == NIL, , ) + + +// --> Save/Restore video state... +#xtranslate SaveState() => { row(), ; + col(), ; + SetColor(), ; + SetCursor(), ; + SaveScreen(,,,,) } + + +#xtranslate RestState() => DispBegin() ;; + RestScreen(,,,,\[\5]) ;; + SetColor(\[\3] ) ;; + SetCursor(\[\4]) ;; + SetPos(\[\1], \[\2] ) ;; + DispEnd() + + +// --> Save/Restore Table state +#xTranslate DbSaveState() => IIF( USED(),; + { Select(), ; + Recno(), ; + OrdBagName(0),; + OrdSetFocus() ; + },; + NIL ) + +#xTranslate DbRestState( ) => IIF( != NIL, ; + ( Select( \[\1] ), ; + OrdListAdd(\[\3] ), ; + OrdSetFocus(\[\4] ), ; + DbGoto(\[\2] )),) + + +// --> Display a Message at MAXROW() with optional colour... +#xTranslate Message(,) => ; + DispOutAt( maxrow(), 0, PadC(, MaxCol()+1 ), ; + IIF( EMPTY(#), "R/W", # ) ) + + +// --> Display a backdrop desktop with optional color +#xTranslate DeskTop([]) => ; + DispBox( 0,0,maxrow(),maxcol(), replicate("�",9), [] ) + + +// --> Display a box with shadow (without savescreen() ) +#xTranslate ShadBox( , , , , , ) ; + => ; + DispBegin() ;; + RESTSCREEN( +1,+2,+1,+2,; + TRANSFORM( ; + SAVESCREEN( +1,+2,+1,+2 ),; + REPLICATE( 'X', ( -+1 ) * ( -+1 ) ) ) );; + DispBox( , , , , [], [] );; + SetPos( +1, +1 );; + DispEnd() + + +// --> Display a box with shadow: Saves screen for WClose() +// --> *MUST* pass to variable, e.g. +// --> +// --> LOCAL aWin := WOpen( 10, 10, 20, 30, B_DOUBLE + " ", "N/W" ) +// --> +#xTranslate WOpen( , , , , [], [] ) ; + => ; + { , , +1, +2, ; + SAVESCREEN( , , +1, +2 ) } ;; + DispBegin() ;; + RESTSCREEN( +1,+2,+1,+2,; + TRANSFORM( SAVESCREEN( +1,+2,+1,+2 ),; + REPLICATE( 'X', ( -+1 ) * ( -+1 ) ) ) );; + DispBox( , , , , ; + IIF(EMPTY(#), "旼엿耗윰 ", ), ; + IIF(EMPTY(#),"W/B", ) );; + SetPos( +1, +1 );; + DispEnd() + + +// --> Display a Caption for a WOpen() window +#xTranslate WTitle( , , ) => ; + DispBox( \[1\], \[2\], ; + \[1\], \[4\]-2, ; + replicate(" ",9), ; + IIF( EMPTY(#), "b/w", # ) ) ;; + DispOutAt( \[1\], \[2\], ; + PADC(, (\[4\]-\[2\])-1, " " ), ; + IIF( EMPTY(#), "b/w", # )) + +// --> Closes a window created with WOpen() - Restores screen +#xTranslate WClose() => RestScreen( \[1\], \[2\], ; + \[3\], \[4\], ; + \[5\] ) + + +// --> Save/Restore full screen - *MUST* pass to/from var +#xtranslate ScreenSave() => SAVESCREEN( 0, 0, 24, 79 ) +#xtranslate ScreenRest( ) => RESTSCREEN( 0, 0, 24, 79, ) + +// --> Build a Picture template +#xtranslate CAPFIRST() => ( "!" + REPLICATE( "X", LEN( ) -1 )) + +// --> Array shrink +#xTranslate ASHRINK( ) => ; + ADEL ( , LEN( ) ) ; + ; ASIZE( , LEN( ) - 1 ) + + +// --> Number to Trimmed String +#xTranslate NTRIM( ) => LTRIM(STR( )) +#xTranslate NUMTRIM( ) => LTRIM(STR( )) +// --> Convert logical to character +#xtranslate LTOC() => IIF( , "T", "F") + +// --> Convert character to logical +#xTranslate CTOL() => IIF( $ "TtYy", .T., .F.) + + +// --> Left trim a numeric +#xtranslate LSTR() => LTRIM( Str( ) ) + + +// --> Carriage Return + Line Feed +#xtranslate CRLF() => ( + CHR(13)+CHR(10) ) +#xtranslate CRLF() => CHR(13) + CHR(10) + + +// --> create a Get/Set Block +#define GSB( xVar) {|x| IIF(x == NIL, xVar, xVar := x )} + +#xtranslate GetSetBlock() => {|x| IIF(x == NIL, , := x )} + +#translate GETSET( , ) => ; + := IIF( == NIL, , := ) + + +// --> Convert Character String to Code Block +#xTranslate COMPILE() => &("{||" + + "}") + + +// --> Errors... +#define Beep() Tone(300,3) + +#xTranslate ErrorTone() => ( TONE( 1000,.01), ; + TONE( 1400,.01), ; + TONE( 1800,.01) ; + ) + + +#define DEF_PATH SET(_SET_DEFAULT) + + +// --> GETs ... +//#define OK_GETS() LASTKEY() != K_ESC .AND. UPDATED() + + + +/* + DATA TYPES +*/ +#xtranslate IS_ARRAY() => (VALTYPE()=="A") +#xtranslate IS_BLOCK() => (VALTYPE()=="B") +#xtranslate IS_CHAR() => (VALTYPE()=="C") +#xtranslate IS_DATA() => ( \>=32 .AND. \<= 253) +#xtranslate IS_DATE() => (VALTYPE()=="D") +#xtranslate IS_DEF() => !(TYPE() $ "UE") +#xtranslate IS_DIGIT() => ISDIGIT() +#xtranslate IS_INT() => ()==INT() ) +#xtranslate IS_LOGIC() => (VALTYPE()=="L") +#xtranslate IS_MEMO() => (VALTYPE()=="M") +#xtranslate IS_NUM() => (VALTYPE()=="N") +#xtranslate IS_OBJECT()=> (VALTYPE()=="O") +#xtranslate IS_TIME() => (VAL(LEFT ,2)) \< 24 .AND. ; + VAL(SUBSTR(,4,2)) \< 60 .AND. ; + VAL(RIGHT(,2 )) \<60 ) + +#translate ISNIL( ) => ( == NIL ) +#translate ISARRAY( ) => ( valtype( ) == "A" ) +#translate ISBLOCK( ) => ( valtype( ) == "B" ) +#translate ISCHARACTER( ) => ( valtype( ) == "C" ) +#translate ISDATE( ) => ( valtype( ) == "D" ) +#translate ISLOGICAL( ) => ( valtype( ) == "L" ) +#translate ISMEMO( ) => ( valtype( ) == "M" ) +#translate ISNUMBER( ) => ( valtype( ) == "N" ) +#translate ISOBJECT( ) => ( valtype( ) == "O" ) + + +#command REPEAT => DO WHILE .T. +#command UNTIL <*lexpr*> => IF (); EXIT ; END ; ENDDO + +#command IF THEN <*statement*> =>; + IIF() ; ; END + +#command IF THEN ELSE =>; + IIF() ; ; ELSE ; ; END + +#define _DEFAULT_CH_ +#endif diff --git a/harbour/contrib/htmllib/errorsys.prg b/harbour/contrib/htmllib/errorsys.prg new file mode 100644 index 0000000000..2a0ba0088b --- /dev/null +++ b/harbour/contrib/htmllib/errorsys.prg @@ -0,0 +1,296 @@ +/* + * $Id$ + */ + + +/*** +* +* Errorsys.prg +* +* Standard Clipper error handler +* +* Copyright (c) 1990-1993, Computer Associates International, Inc. +* All rights reserved. +* +* Compile: /m /n /w +* +*/ + +/* + * Harbour Project source code: + * HTML output conversion + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + + + +#include "default.ch" +#include "error.ch" + + +#define DEF_ERR_HEADER "Date : "+DTOC(Date())+"
"+; + "Time : "+Time()+"
" + + +// put messages to STDERR +#command ? => ?? Chr(13) + Chr(10) ; ?? +#command ?? => OutErr() + + +// used below +#xTranslate NTRIM() => ALLTrim( Str( ) ) + +REQUEST HARDCR +REQUEST MEMOWRIT + +STATIC sbFixCorrupt +STATIC scErrFooter := " " + + +/*** +* ErrorSys() +* +* Note: automatically executes at startup +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +PROC ErrorSys() +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + ErrorBlock( {|e| DefError(e)} ) +return + + + +/*** +* DefError() +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +STATIC FUNC DefError(e) +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +local i, cMessage:= "" +Local cErrString := "" +LOCAL nDispCount := DispCount() +Local aError := {} +LOCAL nH := IF( PageHandle() == NIL, 0, PageHandle() ) + + // by default, division by zero yields zero + IF ( e:genCode == EG_ZERODIV ) + return (0) + END + + IF ( e:genCode == EG_CORRUPTION ) + if valtype(sbFixCorrupt) == "B" + EVAL( sbFixCorrupt, e ) + RETURN .F. + ELSE + RETURN .F. + ENDIF + ENDIF + + // for network open error, set NETERR() and subsystem default + IF ( e:genCode == EG_OPEN .and. (e:osCode == 32 .OR. e:osCode == 5); + .and. e:canDefault ) + + NETERR(.T.) + RETURN (.F.) // NOTE + + END + + + // for lock error during APPEND BLANK, set NETERR() and subsystem default + IF ( e:genCode == EG_APPENDLOCK .and. e:canDefault ) + + NETERR(.T.) + RETURN (.F.) // NOTE + + END + + // build error message + cMessage += ErrorMessage(e) + + + // display message and traceback + IF ( !Empty(e:osCode) ) + cMessage += " (DOS Error : " + NTRIM(e:osCode) + ")" + END + + // RESET System // + + cErrString := CRLF()+""+CRLF() + cErrString += '' + + cErrString += '" + + cErrString += '" + + cErrString += '' + cErrString += '' + cErrString += '"+CRLF()+""+CRLF()+"
' + cErrstring += ''+CRLF() + cErrString += "ERROR REPORT" + cErrString += "
' + cErrstring += ''+CRLF() + cErrString += DEF_ERR_HEADER + cErrString += "
' + cErrstring += ''+CRLF() + cErrString += ''+cMessage+'' + + + cErrString += '
'+CRLF() + cErrstring += ''+CRLF() + cErrString += "ERRORCODE...... :"+ NTRIM(e:GenCode)+"
"+CRLF() + cErrString += "SUBSYSTEM..... :"+ e:SubSystem +"
"+CRLF() + cErrString += "DESCRIPTION...:"+ e:Description +"
"+CRLF() + cErrString += "OPERATION......:"+ e:Operation +"
"+CRLF() + cErrString += "FILENAME........ :"+ e:FileName +"
"+CRLF() + cErrString += "TRIES............. :"+ NTRIM(e:Tries)+CRLF() + + cErrString += '
' + cErrstring += ''+CRLF() + cErrstring += '' + + i := 2 + + while ( !Empty(ProcName(i)) ) + + cErrString += "Called from "+ Trim(ProcName(i)) + ; + "(" + NTRIM(ProcLine(i)) + ")
" + CRLF() + + i++ + END + + cErrstring += '' + cErrString += '
' + cErrstring += ''+CRLF() + cErrstring += "Extra Notes..." + + cErrString += "
"+CRLF() + FWrite( nH, "
"+cErrString+CRLF() ) + //컴컴컴컴 Write/Append Error Log + MemoWrit( "Error.Log", HARDCR(cErrString)+CRLF()+; + HARDCR( MEMOREAD("Error.Log") ) ) + + FWrite( nH, ""+CRLF()+""+CRLF()+""+CRLF() ) + +/* + FWrite( nH, "
"+CRLF() ) + FWrite( nH, "]+CRLF() ) + FWrite( nH, "
"+CRLF() ) + FWrite( nH, ["+CRLF()+""+CRLF() ) + + CLOSE ALL + + // give up + ErrorLevel(1) + QUIT + +RETURN(.F.) + + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +FUNCTION SetCorruptFunc( bFunc ) +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +if valtype( bFunc ) == "B" + sbFixCorrupt := bFunc +ENDIF + +RETURN sbFixCorrupt + + +FUNCTION SetErrorFooter() +RETURN( scErrFooter ) + + +/*** +* ErrorMessage() +*/ +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +STATIC FUNC ErrorMessage(e) +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +local cMessage :="" + + // start error message + cMessage += if( e:severity > ES_WARNING, "Error ", "Warning " ) + + + // add subsystem name if available + IF ( ValType(e:subsystem) == "C" ) + cMessage += e:subsystem() + ELSE + cMessage += "???" + END + + + // add subsystem's error code if available + if ( ValType(e:subCode) == "N" ) + cMessage += ("/" + NTRIM(e:subCode)) + ELSE + cMessage += "/???" + END + + + // add error description if available + if ( ValType(e:description) == "C" ) + cMessage += ("
" + e:description) + END + + + // add either filename or operation + if ( !Empty(e:filename) ) + cMessage += (": " + e:filename) + + ELSEIF ( !Empty(e:operation) ) + cMessage += (": " + e:operation) + + END + cMessage += CRLF() + + +return (cMessage) + diff --git a/harbour/contrib/htmllib/ferror.ch b/harbour/contrib/htmllib/ferror.ch new file mode 100644 index 0000000000..f4897d92a3 --- /dev/null +++ b/harbour/contrib/htmllib/ferror.ch @@ -0,0 +1,87 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FERROR.CH Internal HTMLLIB module + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _FERROR_CH_ + +#define _LAST_IO_ERROR IF(FError() == 0, "", _IO_ERRORS[Ferror()] ) + +#define _IO_ERRORS { ; + "", ; //1 + "File not found", ; //2 + "Path not found", ; //3 + "Too many files open", ; //4 + "Access denied", ; //5 + "Invalid handle", ; //6 + "", ; //7 + "Insufficient memory", ; //8 + "", ; //9 + "", ; //10 + "", ; //11 + "", ; //12 + "", ; //13 + "", ; //14 + "Invalid drive specified", ; //15 + "", ; //16 + "", ; //17 + "", ; //18 + "Attempted to write to a write-protected disk", ; //19 + "", ; //20 + "Drive not ready", ; //21 + "", ; //22 + "Data CRC error", ; //23 + "", ; //24 + "", ; //25 + "", ; //26 + "", ; //27 + "", ; //28 + "Write fault", ; //29 + "Read fault", ; //30 + "", ; //31 + "Sharing violation", ; //32 + "Lock Violation" ; //33 + } + +#define _FERROR_CH_ +#endif diff --git a/harbour/contrib/htmllib/forms.ch b/harbour/contrib/htmllib/forms.ch new file mode 100644 index 0000000000..a048138db9 --- /dev/null +++ b/harbour/contrib/htmllib/forms.ch @@ -0,0 +1,287 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FORMS.CH Include file to create forms + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _FORMS_CH + +#xCommand DEFINE FORM ; + [NAME ] ; + [METHOD ] ; + [ACTION ] ; + [ENCTYPE ] ; + [TARGET ] ; + [ONSUBMIT ] ; + [ONRESET ] ; + [] ; + [CAPTION ] ; + [CAPCOLOR ] ; + [CAPFONTCOLOR ] ; + [CAPIMAGE ] ; + [BGIMAGE ] ; + [FONTCOLOR ] ; + [COLOR ] ; + [WIDTH ] ; + => ; + := Form():New( [], [], [], ; + <.frame.>, ) ;; + [:setTarget( <(target)> ) ;] ; + [:setEncType( <(enctype)> ) ;] ; + [:setCapClr( <(capclr)> ) ;] ; + [:setCapFntClr( <(capfntclr)> ) ;] ; + [:setCapImage( <(capimage)> ) ;] ; + [:setBgImage( <(bgimg)> ) ;] ; + [:setFontColor( <(fntclr)> ) ;] ; + [:setFrmColor( <(clr)> ) ;] ; + [:setwidth( ) ;] ; + [:setAction( <(action)> ) ;] ; + [:setOnSubmit( <(onsubmit)> ) ;] ; + [:setOnReset( <(onreset)> ) ] + + +#xCommand ACTIVATE ; + =>; + :Put(.T.) ; :End() + + +// --> Controls + +#xCommand CONTROL ; + [OF ]; + [] ; + [ALIGN ]; + [WRAP ] ; + [NAME ] ; + [VALUE ] ; + [SIZE ] ; + [MAXCHARS ] ; + [ROWS ] ; + [COLS ] ; + [ONCHANGE ] ; + [ONSELECT ] ; + [ONFOCUS ] ; + [ONBLUR ] ; + [ONCLICK ] ; + [ONMOUSEOVER ] ; + [ONMOUSEOUT ] ; + [ONMOUSEUP ] ; + [ONMOUSEDOWN ] ; + [ONKEYDOWN ] ; + [ONKEYUP ] ; + [ONKEYPRESS ] ; + [PICTURE ] ; + [] ; + [] ; + [] ; + [] ; + [CAPTION ] ; + [STYLE "+CRLF() +; + ''+CRLF()+; + CRLF()+; + ''+CRLF()+; + CRLF()+; + '"+CRLF() +cStr += '"+CRLF() +cStr += '"+CRLF() + +AADD( ::aScript, cStr ) +cStr := "" + +cStr += "Collapsable Lists: Basic Example"+CRLF() +cStr += ""+CRLF() +cStr += ''+CRLF() +cStr += '
'+CRLF() +//cStr += '
'+CRLF() + +FOR i = 0 TO ::nItems +cStr += '
'+CRLF() +NEXT +cStr += ""+CRLF() + +AADD( ::aScript, cStr ) + +RETURN Self + + +/**** +* +* +* +* +* +*/ + +METHOD Put( cFile ) CLASS NcList +IF cFile == NIL +::nH := STD_OUT +ELSE +::nH := FCreate(cFile) +ENDIF + +AEVAL( ::aScript, {|e| fWrite( ::nH, e ) }) + +FClose( ::nH ) + +RETURN Self diff --git a/harbour/contrib/htmllib/jwindow.prg b/harbour/contrib/htmllib/jwindow.prg new file mode 100644 index 0000000000..c2130a4219 --- /dev/null +++ b/harbour/contrib/htmllib/jwindow.prg @@ -0,0 +1,434 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Java Window Class + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" +#include "html.ch" +#include "default.ch" + + +Class JWindow + +DATA nH +DATA Name init "" +DATA oHtm +DATA VarName init "" +DATA URL init "" +DATA Features init "" + +DATA ScreenX, ScreenY init 100 +DATA height, width init 300 +DATA innerHeight, innerWidth, outerHeight init 0 +DATA alwaysRaised, alwaysLowered init .F. +DATA Menubar, personalBar init .F. +DATA location, directories, copyHistory init .F. +DATA Toolbar init .F. +DATA Status, TitleBar init .T. +DATA Scrollbars, Resizable, dependent init .T. + +DATA Title +DATA aScriptSRC +DATA aServerSRC +DATA bgImage, bgColor, fontColor +DATA Style + +DATA onLoad +DATA onUnLoad + +METHOD New( cVarName, cUrl, cName, x, y, w, h ) + +METHOD setOnLoad( c ) INLINE ::onLoad := c +METHOD setOnUnLoad( c ) INLINE ::onUnLoad := c + + +METHOD Alert( c ) INLINE ::QOut( "alert('c')" ) +METHOD confirm(c) INLINE ::QOut( "confirm('c')" ) +METHOD SetSize(x,y,h,w) +METHOD Write( c ) +METHOD lineBreak() INLINE ::QOut( "
" ) +METHOD Paragraph() INLINE ::QOut( "

" ) +METHOD center(l) INLINE ::QOut( IF( l , "
", "
" ) ) +METHOD bold(l) INLINE ::QOut( IF( l , "", "" ) ) +METHOD Italic(l) INLINE ::QOut( IF( l , "", "" ) ) +METHOD ULine(l) INLINE ::QOut( IF( l , "", "" ) ) +METHOD Put() +METHOD Begin() +METHOD End() +METHOD QOut( c ) +METHOD WriteLN( c ) INLINE ::qOut( c ) +METHOD SetFeatures( alwaysRaised, alwaysLowered,; + Resizable, Menubar, personalBar,; + dependent, location, directories,; + Scrollbars, Status, TitleBar, Toolbar ) + +METHOD ImageURL( cImage, cUrl, nHeight, nBorder, ; + cOnClick, cOnMsover, cOnMsout,; + cName, cAlt ) + +//METHOD Debug() INLINE __clsDebug( self ) NOSELF + +ENDCLASS + + + +/**** +* +* Start a new window definition +* +* +* +*/ + +METHOD New( cVarName, cUrl, cName, x, y, w, h ) Class JWindow + +DEFAULT cVarName := "newWin" +DEFAULT cURL := " " +DEFAULT cName := cVarName //"newWin" +DEFAULT x := 100 +DEFAULT y := 100 +DEFAULT h := 300 +DEFAULT w := 300 + +::nH := PageHandle() +::oHtm := oPage() +::varName := cVarName +::URL := cUrl +::Name := cName + +::ScreenX := x +::ScreenY := y +::height := h +::width := w + +// objectViewer( self ) + + +RETURN Self + + + +/**** +* +* Set the properties of the window +* +* +* +*/ + +METHOD SetFeatures( alwaysRaised, alwaysLowered,; + Resizable, Menubar, personalBar,; + dependent, location, directories,; + Scrollbars, Status, TitleBar, Toolbar, copyHistory ) Class JWindow + +LOCAL cStr := "" + +DEFAULT alwaysRaised := ::alwaysRaised +DEFAULT alwaysLowered := ::alwaysLowered +DEFAULT Resizable := ::Resizable +DEFAULT Menubar := ::Menubar +DEFAULT personalBar := ::personalBar +DEFAULT dependent := ::dependent +DEFAULT location := ::location +DEFAULT directories := ::directories +DEFAULT Scrollbars := ::Scrollbars +DEFAULT Status := ::Status +DEFAULT TitleBar := ::TitleBar +DEFAULT Toolbar := ::Toolbar +DEFAULT copyHistory := ::copyHistory + + +IF alwaysRaised ; cStr += "alwaysraised=yes," ; ELSE ; cStr += "alwaysraised=no," ;ENDIF +IF alwaysLowered ; cStr += "alwayslowered=yes," ; ELSE ; cStr += "alwayslowered=no," ;ENDIF +IF Resizable ; cStr += "resizable=yes," ; ELSE ; cStr += "resizable=no," ;ENDIF +IF Menubar ; cStr += "menubar=yes," ; ELSE ; cStr += "menubar=no," ;ENDIF +IF personalBar ; cStr += "personalbar=yes," ; ELSE ; cStr += "personalbar=no," ;ENDIF +IF dependent ; cStr += "dependent=yes," ; ELSE ; cStr += "dependent=no," ;ENDIF +IF location ; cStr += "location=yes," ; ELSE ; cStr += "location=no," ;ENDIF +IF directories ; cStr += "directories=yes," ; ELSE ; cStr += "directories=no," ;ENDIF +IF Scrollbars ; cStr += "scrollbars=yes," ; ELSE ; cStr += "scrollbars=no," ;ENDIF +IF Status ; cStr += "status=yes," ; ELSE ; cStr += "status=no," ;ENDIF +IF TitleBar ; cStr += "titlebar=yes," ; ELSE ; cStr += "titlebar=no," ;ENDIF +IF Toolbar ; cStr += "toolbar=yes," ; ELSE ; cStr += "toolbar=no," ;ENDIF +IF copyHistory ; cStr += "copyHistory=yes," ; ELSE ; cStr += "copyHistory=no," ;ENDIF + +::features += IF( EMPTY( ::Features ), cStr+",", cStr ) + + +RETURN Self + + + + +/**** +* +* set the size for the window +* +* +* +*/ + +METHOD SetSize(x,y,h,w) Class JWindow +LOCAL cStr := "" +DEFAULT x := ::ScreenX ,; + y := ::ScreenY ,; + h := ::height ,; + w := ::width + +::ScreenX := x +::ScreenY := y +::height := h +::width := w + +cStr := "screenX="+ NTRIM(::screenX) +"," + +cStr:= cStr+ "screenY="+ NTRIM(::screenY) +"," +cStr:= cStr+ "height=" + NTRIM(::height) +"," +cStr:= cStr+ "width=" + NTRIM(::width) + +::features += IF( EMPTY( ::Features ), cStr+",", cStr ) + +RETURN Self + + + +/**** +* +* Open the window from within the current document +* +* +* +*/ + +METHOD Put() Class JWindow +LOCAL cStr := "" + +IF ::nH == NIL + ::nH := pageHandle() + IF ::nH == NIL + RETURN Self + ENDIF +ENDIF + +IF Empty( ::features ) + ::setSize() + ::setFeatures() +endif + +IF VALTYPE( ::name ) != "C" + ::name := "newWin" +ENDIF + +cStr += ::varName + " = window.open('"+; + ::URL +"', '"+; + ::varName + "', '"+; + ::features + "')" + +JavaCMD( ::nH, cStr ) + +RETURN Self + + +/**** +* +* Output stand alone Javascript code in the current document +* +*/ + +METHOD Write( c ) Class JWindow + JavaCMD( ::nH, ::varName+".document.write('"+c+"')" + CRLF() ) +RETURN Self + + +/**** +* +* Output Javascript (or HTML) code in the current document and +* in the current script +* +*/ + +METHOD QOut( c ) Class JWindow + FWrite( ::nH, ::varName+".document.write('"+c+"')"+CRLF() ) +RETURN Self + + +/**** +* +* Begin HTML output to the window from within the current document +* and the current script +* +* +*/ + +METHOD Begin() Class JWindow +LOCAL i + +FWrite( ::nH, ""+CRLF() ) + +RETURN Self + + +/**** +* +* End HTML output to the window +* +* +* +*/ + +METHOD End() Class JWindow + +JavaCMD( ::nH, ::varName+".document.write('')" + CRLF() ) + +RETURN Self + + + + +/**** +* +* Place an image link to the window +* +* +* +*/ + +METHOD ImageURL( cImage, cUrl, nHeight, nBorder, ; + cOnClick, cOnMsover, cOnMsout,; + cName, cAlt ) Class JWindow + + +LOCAL cStr := "" + +DEFAULT cUrl := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"'+CRLF() +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"'+CRLF() +ENDIF + +IF nBorder != NIL + cStr += " BORDER = "+NTRIM(nBorder) + CRLF() +ENDIF + +IF nHeight != NIL + cStr += " HEIGHT = "+NTRIM(nHeight) + "% " + CRLF() +ENDIF + +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' + CRLF() +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' + CRLF() +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"'+CRLF() +ENDIF + +IF cURL != NIL + ::QOut( '' ) +ELSE + ::QOut( '' ) +ENDIF +RETURN Self + + + +//*** EOF ***// + diff --git a/harbour/contrib/htmllib/lowfiles.ch b/harbour/contrib/htmllib/lowfiles.ch new file mode 100644 index 0000000000..9667213aae --- /dev/null +++ b/harbour/contrib/htmllib/lowfiles.ch @@ -0,0 +1,59 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * LOWFILES.CH low files commands + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +// Lowfiles.ch + +#include "fileio.ch" + +#translate FGOTOP() => FSEEK( , 0 ) + +#translate FGOBOTTOM() => FSEEK( , 0, FS_END) + +#translate FPOS() => FSEEK( , 0, FS_RELATIVE ) + +#translate FBOF() => (FPOS() == 0) + +#translate FEOF() => (FPOS() == FSize()) + diff --git a/harbour/contrib/htmllib/ocgi.prg b/harbour/contrib/htmllib/ocgi.prg new file mode 100644 index 0000000000..4b8add7536 --- /dev/null +++ b/harbour/contrib/htmllib/ocgi.prg @@ -0,0 +1,309 @@ + +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Cgi Class + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" +#include "default.ch" +#include "html.ch" + + + +CLASS oCgi FROM HTML + +DATA nH +DATA Server_Software +DATA Server_Name +DATA Gateway_Interface +DATA Server_Protocol +DATA Server_Port +DATA Request_Method +DATA Http_Accept +DATA Http_User_agent +DATA Http_Referer +DATA Path_Info +DATA Path_Translated +DATA Script_Name +DATA Query_String +DATA Remote_Host +DATA Remote_Addr +DATA ipAddress +DATA Remote_User +DATA Auth_Type +DATA Auth_User +DATA Auth_Pass +DATA Content_Type +DATA Content_Length +DATA Annotation_Server + +DATA aQueryFields INIT {} + +METHOD New( c ) +METHOD CGIField( c ) + +METHOD toObject() + + +ENDCLASS + + + +/**** +* +* oCgi():new() +* +* +* +*/ + +METHOD New( cInBuffer ) Class oCgi +LOCAL cBuff, i, nBuff +LOCAL aTemp := {} +LOCAL aVar := {} + + // function in oHtm.prg + ::nH := PageHandle() + + ::Server_Software := GetEnv( "SERVER_SOFTWARE" ) + ::Server_Name := GetEnv( "SERVER_NAME" ) + ::Gateway_Interface := GetEnv( "GATEWAY_INTERFACE" ) + ::Server_Protocol := GetEnv( "SERVER_PROTOCOL" ) + ::Server_Port := GetEnv( "SERVER_PORT" ) + ::Request_Method := GetEnv( "REQUEST_METHOD" ) + ::Http_Accept := GetEnv( "HTTP_ACCEPT" ) + ::Http_User_agent := GetEnv( "HTTP_USER_AGENT" ) + ::Http_Referer := GetEnv( "HTTP_REFERER" ) + ::Path_Info := GetEnv( "PATH_INFO" ) + ::Path_Translated := GetEnv( "PATH_TRANSLATED" ) + ::Script_Name := GetEnv( "SCRIPT_NAME" ) + ::Query_String := GetEnv( "QUERY_STRING" ) + ::Remote_Host := GetEnv( "REMOTE_HOST" ) + ::Remote_Addr := GetEnv( "REMOTE_ADDR" ) + ::ipAddress := GetEnv( "REMOTE_ADDR" ) + ::Remote_User := GetEnv( "REMOTE_USER" ) + ::Auth_Type := GetEnv( "AUTH_TYPE" ) + ::Auth_User := GetEnv( "AUTH_USER" ) + ::Auth_Pass := GetEnv( "AUTH_PASS" ) + ::Content_Type := GetEnv( "CONTENT_TYPE" ) + ::Content_Length := GetEnv( "CONTENT_LENGTH" ) + ::Annotation_Server := GetEnv( "ANNOTATION_SERVER" ) + + IF cInBuffer != NIL + ::Query_String := RTRIM( cInBuffer ) + ELSE + IF "POST" $ UPPER(::Request_Method) + ::Query_String := RTRIM(FReadStr( STD_IN, VAL(::CONTENT_LENGTH) )) + ENDIF + ENDIF + + IF !empty( ::Query_String ) + + ::aQueryFields := {} + + aTemp := listAsArray( ::Query_String, "&" ) // separate fields + + IF LEN( aTemp ) != 0 + FOR i=1 TO LEN( aTemp ) + aVar := LISTASARRAY( aTemp[i], "=" ) + IF LEN( aVar ) == 2 + AADD(::aQueryFields, {aVar[1], decodeURL(aVar[2]) } ) + ENDIF + NEXT + ENDIF + ENDIF + +//#ifdef _CLASS_CH +RETURN ::ToObject() //Self +//#else +//RETURN Self +//#endif + + + +//#ifdef _CLASS_CH + + +/**** +* +* oCgi():ToObject() +* +* Creates instance variables out of CGI FORM return values +* or URL encoded content. +* +* It subclasses the oCGI class to a *new* class +*/ + +METHOD ToObject() CLAss ocgi +local i, bBlock +local cFldName +LOCAL nScope:=1 +LOCAL aDb, oDb, hNewClass, oNew, n +LOCAL hNew +STATIC sn := 0 + +// --> create new oObject class from this one... +sn++ +//aDB := ClassNew( "NewCgi"+STRZERO(sn,3), {|| oCGI() }, "cgi" ) +aDb:= hbClass():New("NewCgi"+STRZERO(sn,3),__CLS_PARAM("oCgi" ) ) +FOR i = 1 TO LEN( ::aQueryFields ) + IF ::aQueryFields[i,2] == NIL .OR. EMPTY(::aQueryFields[i,2]) + ::aQueryFields[i,2] := "" + ENDIF + //ClassData( ::aQueryFields[i,1], ::aQueryFields[i,2] ) + adb:AddData( ::aQueryFields[i,1],::aQueryFields[i,2],,nScope) +// adb:AddData( ,,,nScope) +// aDb:AddMultiData(,,if(.F.,1,if(.F.,2,if(.F.,4,nScope) ) ) + if(.F.,16,0 ),__MULTIPARAM("nH" ) ) +NEXT +adb:Create() +//aDB := ClassMAKE() +//hNewClass := aDB[_CLASS_HANDLE] +oNew := adb:Instance() +//aDb := ClassEndIns( oNew, aDB ) +//aDB[_CLASS_OBJECT] := oNew +//oNew:Dict := aDB +oNew:aQueryFields := ::aQueryFields +oNew:Server_Software := ::Server_Software +oNew:Server_Name := ::Server_Name +oNew:Gateway_Interface := ::Gateway_Interface +oNew:Server_Protocol := ::Server_Protocol +oNew:Server_Port := ::Server_Port +oNew:Request_Method := ::Request_Method +oNew:Http_Accept := ::Http_Accept +oNew:Http_User_agent := ::Http_User_agent +oNew:Http_Referer := ::Http_Referer +oNew:Path_Info := ::Path_Info +oNew:Path_Translated := ::Path_Translated +oNew:Script_Name := ::Script_Name +oNew:Query_String := ::Query_String +oNew:Remote_Host := ::Remote_Host +oNew:Remote_Addr := ::Remote_Addr +oNew:ipAddress := ::ipAddress +oNew:Remote_User := ::Remote_User +oNew:Auth_Type := ::Auth_Type +oNew:Content_Type := ::Content_Type +oNew:Content_Length := ::Content_Length +oNew:Annotation_Server := ::Annotation_Server +oNew:nH := IF( PageHandle()==NIL, STD_OUT, PageHandle() ) + +RETURN oNew + +//#endif + +// ripped from HARBOUR + +METHOD CGIField( cQueryName ) Class oCgi + + LOCAL cRet := "" + LOCAL nRet + + DEFAULT cQueryName := "" + + nRet := aScan( ::aQueryFields, ; + { |x| upper( x[1] ) = upper( cQueryName ) } ) + + IF nRet > 0 + cRet := ::aQueryFields[nRet, 2] + ENDIF + +RETURN( cRet ) + + +// ripped from HARBOUR + +FUNCTION ParseString( cString, cDelim, nRet ) + + LOCAL cBuf, aElem, nPosFim, nSize, i + + nSize := len( cString ) - len( StrTran( cString, cDelim, '' ) ) + 1 + aElem := array( nSize ) + + cBuf := cString + i := 1 + FOR i := 1 TO nSize + nPosFim := at( cDelim, cBuf ) + + IF nPosFim > 0 + aElem[i] := substr( cBuf, 1, nPosFim - 1 ) + ELSE + aElem[i] := cBuf + ENDIF + + cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) ) + + NEXT i + +RETURN( aElem[ nRet ] ) + + +// ripped from HARBOUR + +FUNCTION Hex2Dec( cHex ) + + LOCAL aHex := { { "0", 00 }, ; + { "1", 01 }, ; + { "2", 02 }, ; + { "3", 03 }, ; + { "4", 04 }, ; + { "5", 05 }, ; + { "6", 06 }, ; + { "7", 07 }, ; + { "8", 08 }, ; + { "9", 09 }, ; + { "A", 10 }, ; + { "B", 11 }, ; + { "C", 12 }, ; + { "D", 13 }, ; + { "E", 14 }, ; + { "F", 15 } } + LOCAL nRet + LOCAL nRes + + nRet := ascan( aHex, { |x| upper( x[1] ) = upper( left( cHex, 1 ) ) } ) + nRes := aHex[nRet, 2] * 16 + nRet := ascan( aHex, { |x| upper( x[1] ) = upper( right( cHex, 1 ) ) } ) + nRes += aHex[nRet, 2] + + RETURN( nRes ) + diff --git a/harbour/contrib/htmllib/oedit.prg b/harbour/contrib/htmllib/oedit.prg new file mode 100644 index 0000000000..75dea5e9da --- /dev/null +++ b/harbour/contrib/htmllib/oedit.prg @@ -0,0 +1,666 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Editing and Forms Class for HTMLLIB + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" +#include "default.ch" +#include "forms.ch" +#include "html.ch" + +#define _OPTION_TEXT 1 +#define _OPTION_VALUE 2 +#define _OPTION_LABEL 3 +#define _OPTION_SELECTED 4 +#define _OPTION_DISABLED 5 + + +STATIC soForm + +/**** +* +* Class HControl() +* +* +*/ + +CLASS HControl // ALIAS hCtr +DATA nH +DATA Document +DATA Form + + +DATA Caption +DATA lBreak INIT .F. + + +DATA Type INIT "TEXT" +DATA Name +DATA Value +DATA Size +DATA rows, cols + +DATA cOutPut INIT "" + +DATA Picture INIT "@X" + +DATA aOptions INIT {} // SELECT options + +DATA TabIndex INIT 0 +DATA disabled INIT .F. +DATA readOnly INIT .F. +DATA Multiple INIT .F. +DATA style +DATA id + +DATA MaxLength // length in chars +DATA MaxChars // length on screen + +DATA Checked INIT .F. // checkboxes... + +DATA Source, Align // images... +DATA Wrap // textarea + +DATA onBlur +DATA onChange +DATA onFocus +DATA onSelect +DATA onClick +DATA onMouseOver +DATA onMouseOut +DATA onMouseDown +DATA onMouseup +DATA onKeyPress +DATA onKeyDown +DATA onKeyUp +DATA onSelect + +METHOD SetName( c ) INLINE ::Name := c +METHOD SetValue( c ) INLINE ::Value := c +METHOD SetStyle( c ) INLINE ::Style := c +METHOD SetId( c ) INLINE ::id := c +METHOD SetRows( c ) INLINE ::Rows := c +METHOD SetCols( c ) INLINE ::Cols := c +METHOD SetCaption(c) INLINE ::Caption := c +METHOD SetPicture(c) INLINE ::picture := c +METHOD SetOnBlur(c) INLINE ::onBlur := c +METHOD SetOnChange(c) INLINE ::onChange := c +METHOD SetOnFocus(c) INLINE ::onFocus := c +METHOD SetOnSelect(c) INLINE ::onSelect := c +METHOD SetOnClick(c) INLINE ::onClick := c +METHOD SetOnMsOver(c) INLINE ::onMouseOver := c +METHOD SetOnMsOut(c) INLINE ::onMouseOut := c +METHOD SetSize( n ) INLINE ::Size := n +METHOD SetMaxChars( n ) INLINE ::MaxChars := n +METHOD SetChecked( l ) INLINE ::Checked := l +METHOD SetAlign( c ) INLINE ::Align := c +METHOD SetWrap( c ) INLINE ::wrap := c +METHOD SetSource( c ) INLINE ::Source := c +METHOD SetReadOnly( l ) INLINE ::readOnly := l +METHOD SetDisabled( l ) INLINE ::disabled := l +METHOD SetMultiple( l ) INLINE ::multiple := l +METHOD SetOnMsDown(c) INLINE ::onMouseDown := c +METHOD SetOnMsUp(c) INLINE ::onMouseup := c +METHOD SetOnKPress(c) INLINE ::onKeyPress := c +METHOD SetOnKDown(c) INLINE ::onKeyDown := c +METHOD SetOnKUp(c) INLINE ::onKeyUp := c +METHOD SetOnSelect(c) INLINE ::onSelect := c + +//METHOD Debug() INLINE __clsDebug( self ) + +METHOD Put(lPut) +METHOD AddOption( cOption, cValue, cLabel, lSelected, lDisabled ) +METHOD SetControl( name,rows,cols,size,maxchars,value,onfocus,; + onblur,onchange,onselect,onclick,onmsover,onmsout,; + onmsdown,onmsup,onkdown,onkup,onkprs, ; + pic,cap,dis,ro,lMulti,checked,; + align,wrap,type, Style, Id ) + +ENDCLASS + + + +/**** +* +* HControl():Put() +* +* +*/ + +method Put(lPut) CLASS HControl +LOCAL i, cStr := "" + +::nH := pageHandle() +::form := currentForm() + +::cOutput += IF( ::lBreak, CRLF()+"
", CRLF() ) + +IF ::Caption != NIL + ::cOutput += ::Caption + HTMLSPACE(2) +" "+CRLF() +ENDIF + +IF ::Type == "SELECT" +::cOutPut += CRLF()+' " ) +ENDIF + + +RETURN Self + + + +/**** +* +* HControl():AddOption() +* +*/ + +method AddOption( cOption, cValue, cLabel, lSelected, lDisabled ) CLASS HControl +AADD( ::aOptions, { cOption, cValue, cLabel, lSelected, lDisabled } ) +RETURN Self + + + +/**** +* +* HControl():setControl() +* +* Batch set control properties/methods +* +* All default to NIL. See controls.ch +*/ + +method setControl( name,rows,cols,size,maxchars,value,onfocus,; + onblur,onchange,onselect,onclick,onmsover,onmsout,; + onmsdown,onmsup,onkdown,onkup,onkprs, ; + pic,cap,dis,ro,lMulti,checked,; + align,wrap,type, Style, Id ) CLASS HControl +::name := name +::rows := rows +::cols := cols +::size := size +::maxChars := maxchars +::value := value +::onFocus := onfocus +::onBlur := onblur +::onChange := onchange +::onSelect := onselect +::onClick := onclick +::onMouseOver := onmsover +::onMouseOut := onmsout +::onMouseDown := onmsdown +::onMouseUp := onmsup +::onKeyDown := onkdown +::onKeyUp := onkup +::onKeyPress := onkprs +::picture := pic +::caption := cap +::disabled := dis +::readonly := ro +::Multiple := lMulti +::Checked := checked +::Align := align +::Wrap := wrap +::type := type +::Style := Style +::Id := Id + +RETURN Self + + + +/**** +* +* Class Form() +* +* +* +*/ + + +CLASS Form + +DATA nH +DATA aControls init {} +DATA Name init "" +DATA Action +DATA Method //"mailto:name@site" +DATA EncType init "multipart/form-data" +DATA onSubmit +DATA onReset +DATA Target +DATA Frame init .F. +DATA Caption init "" +DATA CaptionColor init "black" +DATA CapFontColor init "white" +DATA CaptionImage +DATA bgImage +DATA fontColor init "black" +DATA Color init "#9196A0" +DATA width init 90 + +DATA cOutput init "" + +METHOD setHandle( h ) INLINE ::nH := h + +METHOD setName( c ) INLINE ::Name := c +METHOD setAction( c ) INLINE ::Action := c +METHOD setMethod( c ) INLINE ::Method := c +METHOD setEncType( c ) INLINE ::encType := c +METHOD setOnSubmit( c ) INLINE ::onSubmit := c +METHOD setOnReset( c ) INLINE ::onReset := c +METHOD setTarget( c ) INLINE ::Target := c +METHOD setCapClr( c ) INLINE ::CaptionColor := c +METHOD setCapFntClr( c ) INLINE ::CapFontColor := c +METHOD setCapImage( c ) INLINE ::CaptionImage := c +METHOD setBgImage( c ) INLINE ::bgImage := c +METHOD setFontColor( c ) INLINE ::FontColor := c +METHOD setFrmColor( c ) INLINE ::Color := c +METHOD setwidth( c ) INLINE ::width := c + + +METHOD AddControl( o ) INLINE IF(Valtype(o)=="O",; + (o:nH := ::nH, o:Form := Self),), ; + AADD( ::aControls, o ) + +METHOD PutControls() INLINE AEVAL( ::aControls, {|e| e:Put() } ) +METHOD New( cName, cAction, cMethod, lFrame, cCaption, nWidth ) +METHOD Put( lPutControls) +METHOD End() +METHOD GetControl( cName) + +//METHOD Debug() INLINE __clsDebug( self ) NOSELF + +ENDCLASS + + +/**** +* +* Form():New() +* +* +*/ + + +method New( cName, cAction, cMethod, lFrame, cCaption, nWidth ) CLASS Form + +DEFAULT cName := "Form1" +DEFAULT cMethod := "POST" +DEFAULT lFrame := .F. +DEFAULT cCaption := "" +DEFAULT nWidth := 90 + +::Name := cName +::Method := cMethod + +::nH := PageHandle() + +::Frame := lFrame +::Caption := cCaption +::width := nWidth + +::aControls := {} + +soForm := Self + +RETURN Self + + + +/**** +* +* Form():Put() +* +* +*/ + +method Put( lPutControls ) CLASS Form + +DEFAULT lPutControls := .F. + +IF VALTYPE(::width) != "N" + ::width := 90 +ENDIF + +IF VALTYPE( ::color ) != "C" + ::Color := "#9196A0" +ENDIF + +IF VALTYPE( ::fontColor ) != "C" + ::fontColor := "black" +ENDIF + +IF VALTYPE( ::CaptionColor ) != "C" + ::CaptionColor := "black" +ENDIF + + +IF ::Frame + ::cOutPut := CRLF()+CRLF()+CRLF()+"" +CRLF()+CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := '"+CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := ''+CRLF() + IF ::Caption != NIL + ::cOutPut := "'+CRLF() + FWrite( ::nH, ::cOutput ) + ENDIF + + ::cOutPut := ""+::Caption+""+CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := "" + FWrite( ::nH, ::cOutput ) + ENDIF + + ::cOutPut := '' +CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := ''+CRLF() + FWrite( ::nH, ::cOutput ) + ENDIF + +ENDIF +::cOutput+= CRLF()+"
" + CRLF() ) +IF ::Frame + FWrite( ::nH, ""+CRLF() ) + FWrite( ::nH, ""+CRLF() ) + FWrite( ::nH, "
"+CRLF() ) +Endif +FWrite( ::nH, CRLF()+CRLF()+"" +CRLF()+CRLF()+CRLF() ) +RETURN Self + + + +/**** +* +* Form():getControl() +* +* Retrieve a form control object by name +* +*/ + +method getControl( cName ) CLASS Form + +LOCAL oRet +LOCAL nPos := ASCAN( ::aControls, {|e| e:name = cName } ) +IF nPos > 0 + oRet := ::aControls[nPos] +ENDIF + +RETURN oRet + + + +/**** +* +* oForm() +* +* Return current form +* +*/ + +FUNCTION oForm() +RETURN soForm + + diff --git a/harbour/contrib/htmllib/ofile.prg b/harbour/contrib/htmllib/ofile.prg new file mode 100644 index 0000000000..a6b86d9fb7 --- /dev/null +++ b/harbour/contrib/htmllib/ofile.prg @@ -0,0 +1,560 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Base fileIO class. + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" + +#include "default.ch" +#include "fileio.ch" +#include "ferror.ch" +//#include "simpleio.ch" + +#translate FPOS() => FSEEK( , 0, FS_RELATIVE ) + +#ifdef TEST +PROC TEST() +LOCAL oF +oF := FileBase():New( "c:\autoexec.bat" ) //oFile.prg" ) +oF:Open() +? of:handle +while !oF:EOF() +? oF:ReadLine() +inkey(0) +ENDDO +#endif + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + CLASS FileBase // ALIAS FB +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +DATA Buffer INIT "" // Self[1] +DATA Name INIT "" +DATA Handle //INIT -999 +DATA FileSize INIT 0 +DATA BytesRead INIT 0 +DATA cPage INIT "" +DATA nPage INIT 0 +DATA nPageSize INIT 1024 +DATA nRecord INIT 0 + +METHOD New( cName ) +METHOD Open( nMode ) +METHOD Close() INLINE FClose( ::Handle ), ; + ::Handle := -999 + +METHOD Rename(c) INLINE FRename( ::File, c ) == 0 +METHOD Erase() INLINE Ferase( ::File ) == 0 +METHOD Exists() INLINE File( ::File ) +METHOD Error() INLINE Ferror() != 0 + +METHOD Tell() INLINE Fseek(::handle,FS_RELATIVE,0) +METHOD Pointer() INLINE FPOS( ::handle ) +METHOD ReadStr(n) INLINE ::Buffer := ; + FReadStr( ::Handle, n ) +METHOD Write( c, n ) INLINE FWrite( ::Handle, c, n ) +METHOD WriteByte( n ) +METHOD WriteInt( n ) +METHOD WriteLong( n ) +METHOD GetBuffer() INLINE ::Buffer + +METHOD GoTop() INLINE FSEEK( ::Handle, 0 ) +METHOD GoBottom() INLINE FSEEK( ::Handle, 0, FS_END) +METHOD Bof() INLINE ( FPOS(::Handle) == 0) +METHOD Eof() INLINE FPOS(::Handle) == ::FileSize +METHOD Seek( n, o ) INLINE FSeek( ::Handle, n, o) +METHOD Create( n ) +METHOD Size() + +METHOD _Read( n, c ) +METHOD ReadAhead( n, c ) +METHOD ReadLine( n ) +METHOD PrevLine( nBytes ) +METHOD ReadByte() +METHOD ReadInt() +METHOD ReadLong() + +METHOD GoTo( n ) +METHOD Skip( n ) + +METHOD MaxPages(n) +METHOD PrevPage(n) +METHOD NextPage(n) + +ENDCLASS + + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD New( cName ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +::Name := cName +::Buffer := "" // Self[1] +::Handle := 0 +::FileSize := 0 +::BytesRead := 0 +::cPage := "" +::nPage := 0 +::nPageSize := 1024 +::nRecord := 0 +RETURN Self + + +/* +** ::Open( [] ) --> lSuccess +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD Open( nMode ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +DEFAULT nMode := FO_EXCLUSIVE //SHARED +::Handle := FOpen( ::Name, nMode ) +IF ::Handle > 0 + ::Size() +ENDIF +RETURN ::Handle > 0 + + +/* +** ::Create( [] ) --> lSuccess +*/ +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD Create( nAttr ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nSuccess +DEFAULT nAttr := 0 +nSuccess := FCreate( ::Name, nAttr ) +::Handle := nSuccess +RETURN (nSuccess != -1) + + + +/* +** ::Size() --> nFileSize +** +** RETURNs the size in bytes of the current file. +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD Size() CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nCurrent,nLength + +nCurrent := FPOS( ::Handle ) +nLength := FSEEK( ::Handle, 0, FS_END ) + +FSEEK( ::Handle, nCurrent ) +::FileSize := nLength + +RETURN( nLength ) + + + +/* +** ::Read( [], [@] ) --> nBytesRead +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD _Read( nSize, cBuff ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nBytesRead + +DEFAULT nSize := 1024 +DEFAULT cBuff := SPACE(nSize) + +::BytesRead := FRead( ::Handle, @cBuff, nSize ) +::Buffer := cBuff + +RETURN( cBuff ) //nBytesRead ) + + + +/* +** ::ReadAhead( [], [@] ) --> nBytesRead +** +** Read forward in the file without moving the pointer. +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD ReadAhead( nSize, cBuff ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nBytesRead, nCurrent + +DEFAULT nSize := 1024 +DEFAULT cBuff := SPACE(nSize) + +// --> save position in file +nCurrent := FPOS( ::Handle ) + +// --> read ahead +::BytesRead := FRead( ::Handle, @cBuff, nSize ) + +// --> RETURN to saved position +FSEEK( ::Handle, nCurrent ) + +RETURN( cBuff ) + + + +/* +** ::ReadLine( [] ) --> cLine +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD Readline( nSize ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL cString, nCurrent, nCr + +DEFAULT nSize := 1024 + +IF nSize <= 0 + RETURN( "" ) +ENDIF + +nCurrent := FSEEK( ::Handle, 0, 1 ) +cString := FREADSTR( ::Handle, nSize ) +nCr := AT( CHR(13), cString ) + +FSEEK( ::Handle,nCurrent,0 ) +FSEEK( ::Handle,nCr+1,1 ) + +::Buffer := SUBSTR( cString, 1, nCr-1 ) +::nRecord++ + +RETURN ::Buffer + + + +/* +** ::ReadByte() --> nByte or -1 if unsuccessfull +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD ReadByte() CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nRet, nBytes +LOCAL cBuff := SPACE( 1 ) + +nBytes := FRead( ::Handle, @cBuff, 1 ) + +RETURN( IF( nBytes > 0, ASC(cBuff), -1 ) ) + + + +/* +** ::ReadInt() --> nUnsignedInt or -1 if unsuccessfull +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD ReadInt() CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nRet, nBytes +LOCAL cBuff := SPACE( 2 ) + +nBytes := FRead( ::Handle, @cBuff, 2 ) + +RETURN( IF( nBytes > 0, BIN2I(cBuff), -1 ) ) + + + +/* +** ::ReadLong() --> nLong or -1 if unsuccessfull +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD ReadLong() CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nRet, nBytes +LOCAL cBuff := SPACE( 4 ) + +nBytes := FRead( ::Handle, @cBuff, 4 ) + +RETURN( IF( nBytes > 0, BIN2L(cBuff), -1 ) ) + + + + +/* +** ::WriteByte( nByte ) --> lSuccess +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD WriteByte( nByte ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL lSuccess := ( FWrite( ::nHandle, chr( nByte ), 1 ) == 1 ) +RETURN lSuccess + + + + +/* +** ::WriteInt( nInt ) --> lSuccess +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD WriteInt( nInt ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL lSuccess := ( FWrite( ::nHandle, I2BIN( nInt ), 2 ) == 2 ) +RETURN lSuccess + + + +/* +** ::WriteLong( nLong ) --> lSuccess +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD WriteLong( nLong ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL lSuccess := ( FWrite( ::nHandle, L2BIN( nLong ), 4 ) == 4 ) +RETURN( lSuccess ) + + + +/* +** ::GOTO( ) --> nPrevPos +** +** Skips to line from top. RETURNs previous position in file. +** +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD GoTo( nLine ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nCount := 1 +LOCAL nPos := FPOS( ::Handle ) + +::GoTop() + +IF nLine < 0 // don't accept < 0 + RETURN( nPos ) +ELSEIF nLine == 0 + nLine := 1 + ::nRecord := 1 + ::GoTop() + RETURN( nPos ) +ENDIF + +WHILE !::EOF() + + ::ReadLine() + + IF nCount == nLine ; EXIT ; ENDIF + + nCount++ +ENDDO + +RETURN( nPos ) + + +/* +** ::Skip( [] ) --> nPrevPos +** +** Skips to line from top. RETURNs previous position in file. +** +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD Skip( nLines ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL nCount := 0 +LOCAL nPos := FPOS( ::Handle ) + +DEFAULT nLines := 1 + +IF nLines <= 0 // don't accept < 0 + + RETURN nPos + +ENDIF + +WHILE !::EOF() + + IF nCount == nLines ; EXIT ; ENDIF + + ::ReadLine() + nCount++ +ENDDO +RETURN( nPos ) + + +/* +** ::MaxPages( ) --> nMaxPages +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD MaxPages( nPageSize ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +DEFAULT nPageSize := ::nPageSize +RETURN( ::Size() / nPageSize ) + + + +/* +** ::PrevPage( [] ) --> cPage +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD PrevPage( nBytes ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + +DEFAULT nBytes := 1024 + +IF nBytes <= 0 + RETURN( "" ) +ENDIF + +IF !::BOF() + FSEEK( ::Handle, -nBytes, FS_RELATIVE) + ::cPage := FREADSTR( ::Handle, nBytes ) + FSEEK( ::Handle, -nBytes, FS_RELATIVE) + ::nPage-- +ENDIF + +RETURN( ::cPage ) + + + +/* +** ::NextPage( [] ) --> cPage +*/ + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD NextPage( nBytes ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + +DEFAULT nBytes := 1024 + +IF nBytes <= 0 + RETURN( "" ) +ENDIF + +IF !::EOF() + ::cPage := FREADSTR( ::Handle, nBytes ) + ::nPage++ +ENDIF + +RETURN( ::cPage ) + + +/* +** ::PrevLine( [] ) --> ::Buffer +*/ +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD PrevLine( npBytes ) CLASS FileBase +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +LOCAL fHandle := ::Handle +LOCAL nOrigPos := FPOS(fHandle), nMaxRead, nNewPos, ; + lMoved, cBuff, nWhereCrLf, nPrev, cTemp + +DEFAULT npBytes := 256 + + IF nOrigPos == 0 + + lMoved := .F. + + ELSE + + lMoved := .T. + + // Check preceeding 2 chars for CR+LF + FSeek(fHandle, -2, FS_RELATIVE) + cTemp := Space(2) + FRead(fHandle, @cTemp, 2) + + IF cTemp == CRLF() + FSeek(fHandle, -2, FS_RELATIVE) + ENDIF + + nMaxRead := MIN( npBytes, FPOS(fHandle)) + + cBuff := Space(nMaxRead) + nNewPos := FSeek(fHandle, -nMaxRead, FS_RELATIVE) + FRead(fHandle, @cBuff, nMaxRead) + nWhereCrLf := RAT( CRLF(), cBuff ) + IF nWhereCrLf == 0 + + nPrev := nNewPos + ::Buffer := cBuff + + ELSE + + nPrev := nNewPos + nWhereCrLf + 1 + ::Buffer := SubStr(cBuff, nWhereCrLf + 2) + + ENDIF + + FSeek(fHandle, nPrev, FS_SET) + + ENDIF + +RETURN IF( lMoved, ::Buffer, "" ) + + +/* + * * * * * UNCHECKED !!! * * * * * + +METHOD PrevLine( nBytes ) CLASS FileBase +LOCAL cRet, cPage := "" +LOCAL nAt := 0 +LOCAL nPos := FPOS( ::Handle ) +DEFAULT nBytes := 1024 + +IF nBytes <= 0 + RETURN( "" ) +ENDIF + +IF !( FPOS(::Handle) == 1) // !BOF() + FSEEK( ::Handle, -nBytes, FS_RELATIVE) // position back + cPage := FREADSTR( ::Handle, nBytes ) // read forward + nAt := RAT( Chr(13), cPage ) // find crlf() + cRet := RIGHT( cPage, nAt+1) + //FSEEK( ::Handle, -(nAt-1), FS_RELATIVE) + FSEEK( ::Handle, nPos ) + FSEEK( ::Handle, -(nAT-1), 1 ) +ENDIF + +RETURN( cRet ) +*/ + diff --git a/harbour/contrib/htmllib/oframe.prg b/harbour/contrib/htmllib/oframe.prg new file mode 100644 index 0000000000..9a697e5e83 --- /dev/null +++ b/harbour/contrib/htmllib/oframe.prg @@ -0,0 +1,224 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * HTMLLIB Frame Class + * + * Copyright 2000 Manos Aspradakis + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbclass.ch" +#include "default.ch" +#include "html.ch" + + + +CLASS Frameset +DATA nH +DATA FName +DATA Title init "FrameSet01" + + +METHOD New( fName, title ) +METHOD StartSet( aRows, aCols, onLoad, onUnload ) +METHOD EndSet() +METHOD End() +METHOD Frame( cName, cURL, lBorder, lResize, lScrolling,; + marginwidth, marginheight, cTarget, cScrolling ) + +//METHOD Debug() INLINE __clsDebug( self ) NOSELF + +ENDCLASS + + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD New( cFName, cTitle ) CLASS Frameset + +LOCAL cStr := "" + +DEFAULT cTitle := "" + +::FName := cFName +::Title := cTitle + + +IF ::FName == NIL + cStr += "Content-Type: text/html"+CRLF()+CRLF() +// cStr := "" + ::nH := STD_OUT +ELSE + cStr := "" + ::nH := FCreate( ::FName ) +ENDIF + +cStr += ""+CRLF()+; + " "+CRLF()+; + " "+::Title+""+CRLF()+; + " "+CRLF() + +FWrite( ::nH, cStr ) + +RETURN Self + + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD StartSet( aRows, aCols, onLoad, onUnload ) CLASS Frameset +LOCAL i +LOCAL cStr := "" + +cStr += CRLF()+" "+CRLF() ) +RETURN Self + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +Method End() CLASS Frameset +FWrite( ::nH, ""+CRLF() ) +IF ::FName != NIL + FClose( ::nH ) +ENDIF +RETURN Self + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +METHOD Frame( cName, cURL, lBorder, lResize, lScrolling,; + marginwidth, marginheight, cTarget, cScrolling ) CLASS Frameset + +LOCAL cStr + +DEFAULT lBorder := .T. +DEFAULT lResize := .T. +DEFAULT lScrolling := .F. +DEFAULT cScrolling := "AUTO" +DEFAULT cTarget := "_self" //"_blank" + +cStr := " + * 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 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#include "default.ch" +#include "hbclass.ch" +#include "html.ch" + +STATIC saGreek := {} +STATIC snHtm := NIL //0 +STATIC scForm := 0 +STATIC soPage := 0 + + +/**** +* +* Class HTML() +* +* +* Constructors : +* +* Html():New() Creates a new HTML document +* +* Html():CGINew() Creates a new CGI-HTML document +* +*/ + +CLASS Html + +DATA nH +DATA FName, Title +DATA FontFace INIT "Verdana" // Note! +DATA FontSize INIT 1 +DATA FontColor INIT "black" +DATA aImages +DATA BaseURL, BaseTarget +DATA lFont init .F. + +// --- INIT --- // +METHOD New( cFile, cTitle, cLinkTitle, cCharSet, cScriptSRC,; + bgImage, bgColor, txtColor, cJavaCode,; + onLoad, onUnload, cLinkClr, cVLinkClr, cALinkClr,; + cStyle, aimages, baseURL, baseTarget,; + nRefresh, cRefreshURL ,cStyleScr,lnocache) +METHOD CGINew( cTitle, cLinkTitle, cCharSet, cScriptSRC, bgImage, bgColor, txtColor, cJavaCode, onLoad, onUnload, cLinkClr, cVLinkClr, cALinkClr,cStyle, aImages, aServerSrc, baseURL, baseTarget,nRefresh, cRefreshURL ,cStyleScr,lnocache) + +/* METHOD Debug() INLINE __clsDebug( self ) NOSELF */ + +// --- HEADER --- // +METHOD SetPageColor( cColor ) INLINE FWrite(::nH, '' ) +METHOD SetTextColor( cColor ) INLINE FWrite(::nH, '' ) +METHOD SetBgImage( cImage ) INLINE FWrite(::nH, '' ) + +// --- END --- // +METHOD Close() +METHOD CGIClose() + + +// --- FONTS --- // +METHOD SetCenter( lOn ) INLINE FWrite( ::nH, IF( lOn, "
", "
" ) ) +METHOD SetFont( cFont, lBold, lItalic, lULine, nSize, cColor ,lSet) +METHOD StartFont( cFont, lBold, lItalic, lULine, nSize, cColor ,lSet) +METHOD DefineFont( cFont, cType, nSize, cColor , lSet) +METHOD EndFont() + + +// --- OUTPUT --- // + +METHOD Say( str, font, size, type, color ,style) + +METHOD QQOut( c ) INLINE ; + DEFAULT(c, ""), ; + FWrite( ::nH, c ) + +METHOD QOut( c ) INLINE ; + DEFAULT(c, ""), ; + FWrite( ::nH, CRLF()+c+'
'+CRLF() ) + +METHOD Write( c ) INLINE ; + DEFAULT(c, ""), ; + FWrite( ::nH, c ) + +METHOD WriteLN( c ) INLINE ; + DEFAULT( c, "" ),; + FWrite( ::nH, CRLF()+c+'
'+CRLF() ) + +METHOD SayColor( t, c ) INLINE ; + DEFAULT( t, "" ),; + DEFAULT( c, "black" ),; + FWrite(::nH, ''+t+'') + +METHOD Space( n ) INLINE ; + DEFAULT( n, 1 ),; + FWrite( ::nH, replicate( " ", n) ) + +METHOD PutImage( cImage, nBorder, nHeight,; + cOnclick, cOnMsOver, cOnMsOut, ; + cName, cAlt, cTarget ,nWidth,lbreak) + +METHOD Text( cText, nCols, lWrap ) ; + INLINE ; + DEFAULT( lWrap, .T. ),; + DEFAULT( nCols, 80 ),; + FWrite( ::nH, "", ">")+CRLF()+; + cText+CRLF()+""+CRLF() ) + + +METHOD MultiCol( txt, cols, gutter, width ) INLINE ; + DEFAULT( txt, "" ),; + DEFAULT( cols, 2 ),; + DEFAULT( gutter, 5 ),; + DEFAULT( width, 100 ),; + FWrite( ::nH, '' ),; + FWrite( ::nH, txt ),; + FWrite( ::nH, "" ) + +// --- COSMETICS --- // +METHOD PutHeading( cText, nWeight, lCentered ) + +METHOD HLine( nSize, nWidth, lShade, cColor) +/* INLINE ; + nSize := IF( nSize == NIL, 3, nSize ),; + nWidth := IF( nWidth == NIL, 90, nWidth ),; + FWrite( ::nH, '

'+CRLF()+'

') +*/ +METHOD PutParagraph() INLINE FWrite( ::nH, "

"+CRLF() ) + +METHOD Paragraph( l, c, style ) + +METHOD PutBreak() INLINE FWrite( ::nH, "
"+CRLF() ) + + +METHOD Marquee( cText, cFont, cFntColor, nFntSize, ; + cAlign, nWidth, nHeight, cbgColor, ; + cBehavior, cDirection , ; + nScrollAmt, nScrollDelay, loop,; + onMsOver, onMsOut, onClick, onStart, onFinish ) + +METHOD StartMarquee( cFont, cFntColor, nFntSize, ; + cAlign, nWidth, nHeight, cbgColor, ; + cBehavior, cDirection , ; + nScrollAmt, nScrollDelay, loop, ; + onMsOver, onMsOut, onClick, onStart, onFinish ) +METHOD EndMarquee() + +// --- URLs --- // +METHOD PutTextUrl( cText, cUrl, cOnClick, cOmMsOver, cOnMsout, cTarget ,/*new parameters*/ font,clr,size,style,bld,lbreak,cClass) +METHOD PutImageUrl( cImage, nBorder, nHeight,nWidth, cUrl,; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak,cClass) + + + +// --- TABLES --- // +METHOD DefineTable( nCols, nBorder, nWidth,nHeight, ColorFore, ColorBG, ; + l3d, lRuleCols, lRuleRows, ; + cClrDark, cClrLight, ncellpadding, ncellspacing,cAling ,lRules,bgImage,cStyle) + +METHOD TableHead( cHead, cColor, cAlign, ; + cFont, nSize, cFntColor, nHeight, cBgPic ) + +METHOD NewTableRow(cColor) +METHOD EndTableRow() +METHOD NewTableCell( cAlign, cColor, ; + cFont, nSize, cFntColor, nHeight, ; + cBgPic, ; + nWidth, lWrap,; + nCSpan, nRSpan ,cValing,clrdrk,clrlt,cBdrClr,cclass) + +METHOD EndTableCell() +METHOD EndTable() + + +// --- LISTS --- // +method newList() INLINE FWrite( ::nH, "
    "+CRLF() ) +method ListItem() INLINE FWrite( ::nH, "
  • " ) +method EndList() INLINE FWrite( ::nH, "
" ) + + +// --- FORMS --- // +METHOD NewForm( cMethod, cAction, cName ) +METHOD FormImage( cText, name, File ) +METHOD FormGet( cType, cName, xValue, nSize ) +METHOD FormReset( c ) +METHOD FormSubmit( c ) +METHOD FormQOut( c ) INLINE FWrite( ::nH, c + '
'+CRLF() ) +METHOD FormQQOut( c ) INLINE FWrite( ::nH, c + CRLF() ) +METHOD EndForm() INLINE FWrite( ::nH, CRLF()+""+CRLF() ) + +METHOD PushButton( cName, cCaption, ; + cCgiApp,; + cOnClick, ; + cOnFocus, cOnBlur, ; + cOnMsOver, cOnMsOut,; + style, id ) + +METHOD endButton() + +METHOD Button( cName, cCaption, ; + cOnClick, cCGIApp, ; + cOnMsOver, cOnMsOut,; + style, id ) + +METHOD iFrame( name, src, border, ; + marginwidth, marginheight, ; + scrolling, allign, ; + width, height) + + +// --- JAVA SUPPORT --- // +METHOD StartJava() INLINE ; + FWRITE( ::nH, '"+CRLF() ) + +METHOD serverCode(c) INLINE FWRITE( ::nH, ""+; + SPACE(9) + c +CRLF()+; + ""+CRLF() ) + +// standard output + +METHOD FWrite( c ) INLINE ; + FWrite( ::nH, c ) +METHOD FWriteLN( c ) INLINE ; + FWrite( ::nH, c + CRLF() ) + + +METHOD Span(c,Style) +METHOD PutTextImageUrl( cImage, nBorder, nHeight, cUrl, ; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak,cClass,cText) +METHOD Comment(cText) +METHOD ADDoBJECT(cType,cClassid,cAling,cCode,lDisable,cCodeBase,cName,nWidth,nHeight) +METHOD ADDPARAM(cName,cValue) +METHOD EndOBJect() +METHOD PutLinkName( cName ) +ENDCLASS + + + + +/**** +* +* Html():New() +* +* Starts a new HTML disk file. +*/ + +METHOD New( cFile, cTitle, cLinkTitle, cCharSet, aScriptSRC,; + bgImage, bgColor, txtColor, aJavaCode,; + onLoad, onUnload, cLinkClr, cVLinkClr, cALinkClr,; + cStyle, aImages, cBaseURL, cBaseTarget,; + nRefresh, cRefreshURL ,cStyleScr,lnocache) CLASS Html + +LOCAL i + +DEFAULT cFile := "file1.htm" +DEFAULT cTitle := "test HTML page" +DEFAULT cLinkTitle := cTitle +DEFAULT cRefreshURL:= "" +DEFAULT cCharset := "windows-1253" + +::nH := FCreate( cFile ) +::Title := cTitle +::FName := cFile + +FWRITE( ::nH, ''+CRLF() +; + ''+CRLF() +; + ' ' +cTitle+' '+CRLF() ) + +IF cBaseURL != NIL +FWRITE( ::nH, ""+CRLF() ) +ENDIF +IF cStyleScr != NIL + FWRITE( ::nH, ' "+CRLF()) +ENDIF + +FWRITE( ::nH, ' '+CRLF()+; + ' '+CRLF() ) + +IF nRefresh != NIL + FWrite( ::nH, [ ] ) +ENDIF + +if lnocache + FWrite( ::nH, [ ]) +ENDIF +IF aJavaCode != NIL + AEVAL( aJavaCode, {|e| JavaCMD( ::nH, e ) } ) +ENDIF + +IF aScriptSrc != NIL + FOR i =1 TO LEN( aScriptSrc ) + FWRITE( ::nH, ; + ''+CRLF() ) + NEXT +ENDIF + + +// preload images... +IF aImages != NIL + ::aImages := aImages + FWRITE( ::nH, ; + ''+CRLF() ) + +ENDIF + + +IF cStyle != NIL + FWRITE( ::nH, ""+CRLF() ) +ENDIF + +FWrite( ::nH,; + CRLF()+''+; + CRLF()+'' ) +FWrite( ::nH, CRLF() ) + + +IF bgImage != NIL + ::SetBgImage( bgImage ) +ENDIF + +IF bgColor != NIL + ::SetPageColor( bgColor ) +ENDIF + +IF txtColor != NIL + ::SetTextColor( txtColor ) +ENDIF + +snHtm := ::nH + +soPage := Self + +RETURN self + + + +/**** +* +* Html():CGINew() +* +* Starts a new CGI-HTML stream file. +*/ + +METHOD CGINew( cTitle, cLinkTitle, cCharSet, aScriptSRC,; + bgImage, bgColor, txtColor, aJavaCode, ; + onLoad, onUnload, ; + cLinkClr, cVLinkClr, cALinkClr, ; + cStyle, aImages, aServerSrc, ; + cBaseURL, cBaseTarget,; + nRefresh, cRefreshURL,cStyleScr ,lNocache) CLASS Html + +LOCAL i + + +//DEFAULT lAuthenticate := .F. +DEFAULT cTitle := "CGI HTML page" +DEFAULT cLinkTitle := cTitle +DEFAULT cRefreshURL:= "" +DEFAULT cCharset := "windows-1253" + +::nH := STD_OUT //FCreate( cFile ) +::Title := cTitle +::FName := "CGIOUT.HTM" + +FWRITE( ::nH, 'Content-Type: text/html'+CRLF()+CRLF() ) + +/* +IF lAuthenticate == .T. .and. ; + ( EMPTY(GetEnv( "AUTH_USER" )) .OR. EMPTY( GetEnv( "AUTH_PASS" )) ) + FWRITE( ::nH,""+CRLF() ) + FWRITE( ::nH,"HTTP/1.0 401 Not Authorized"+CRLF() ) + FWRITE( ::nH,'WWW-Authenticate:Basic Realm="'+cTitle+'"'+CRLF() ) + FWRITE( ::nH,""+CRLF() ) + FClose( ::nH ) + RETURN Self +ENDIF +*/ + +FWRITE( ::nH, ''+CRLF() +; + ''+CRLF() +; + ' ' +cTitle+' '+CRLF() ) + +IF cBaseURL != NIL +FWRITE( ::nH, ""+CRLF() ) +ENDIF + +FWRITE( ::nH, ' '+CRLF()+; + ' '+CRLF() ) + +IF cStyleScr != NIL + FWRITE( ::nH, ' "+CRLF()) +ENDIF +IF nRefresh != NIL + FWrite( ::nH, [ ] ) +ENDIF +if lnocache + FWrite( ::nH, [ ]) +ENDIF + +IF aJavaCode != NIL + AEVAL( aJavaCode, {|e| JavaCMD( ::nH, e ) } ) +ENDIF + +IF aScriptSrc != NIL + FOR i =1 TO LEN( aScriptSrc ) + FWRITE( ::nH, ; // RUNAT=SERVER + ''+CRLF() ) + NEXT +ENDIF + +IF aServerSrc != NIL + FOR i =1 TO LEN( aServerSrc ) + FWRITE( ::nH, ; // RUNAT=SERVER + ''+CRLF() ) + NEXT +ENDIF + +// preload images... +IF aImages != NIL + ::aImages := aImages + FWRITE( ::nH, ; + ''+CRLF() ) + +ENDIF + +IF cStyle != NIL + FWRITE( ::nH, ""+CRLF() ) +ENDIF + +FWrite( ::nH,; + ''+CRLF()+; + '' ) + +FWrite( ::nH, CRLF() ) + +IF bgImage != NIL + ::SetBgImage( bgImage ) +ENDIF + +IF bgColor != NIL + ::SetPageColor( bgColor ) +ENDIF + +IF txtColor != NIL + ::SetTextColor( txtColor ) +ENDIF + +snHtm := ::nH + +soPage := Self + +RETURN self + + + +/**** +* +* Html():SetFont() +* +* obvious... +*/ + +METHOD SetFont( cFont, lBold, lItalic, lULine, nSize, cColor ,lSet) CLASS Html +LOCAL cStr := CRLF()+'' + if lset + ::fontColor := cColor + endif +ELSE + cStr += ">" +ENDIF + + +IF lBold != NIL + IF( lBold, cStr += '', cStr += '') +ENDIF +IF lItalic != NIL + IF( lItalic, cStr += '', cStr += '') +ENDIF + +IF lULine != NIL + IF( lULine, cStr += '', cStr += '') +ENDIF + +cStr += '' +FWrite( ::nH, cStr + CRLF() ) +RETURN Self + + +/**** +* +* Html():StartFont() +* +* Begin a font definition. They may be nested but make sure you +* end the definition appropriately later +*/ + +METHOD StartFont( cFont, lBold, lItalic, lULine, nSize, cColor ,lSet) CLASS Html +LOCAL cStr := "' + if lSet + ::fontColor := cColor + endif +ELSE + cStr += ">" +ENDIF + +IF lBold != NIL + IF( lBold, cStr += '', cStr += '') +ENDIF +IF lItalic != NIL + IF( lItalic, cStr += '', cStr += '') +ENDIF + +IF lULine != NIL + IF( lULine, cStr += '', cStr += '') +ENDIF + +FWrite( ::nH, cStr + CRLF() ) + +RETURN Self + + +/**** +* +* Html():DefineFont() +* +* Begin a font definition by font type "name". +* Use ::endFont() to cancel this font +*/ + +METHOD DefineFont( cFont, cType, nSize, cColor ,lSet) CLASS Html +LOCAL cStr := "' + if lset + ::fontColor := cColor + endif +ELSE + cStr += ">" +ENDIF + + +IF cType != NIL + cStr += cType +ENDIF + +FWrite( ::nH, cStr + CRLF() ) + +RETURN Self + + + +/**** +* +* Html():EndFont() +* +* End a font definition +*/ + +METHOD endFont() CLASS Html +FWrite( ::nH, '' + CRLF() ) +RETURN Self + + + +/**** +* +* Html():say() +* +* +* +*/ + +METHOD Say( str, font, size, type, color ,style) CLASS Html +LOCAL cOut := "" +LOCAL lBold := .F., lItalic:= .F., lULine := .F.,lEm:=.f.,lStrong:=.f. +Local nSize:=Size +DEFAULT str := "" +DEFAULT font := ::FontFace +DEFAULT size := ::FontSize +DEFAULT color:= ::FontColor +if Font != nil .or. Size !=Nil .or. color != Nil +cOut := '' +Else + cOut += '>' +Endif +endif +IF VALTYPE( type ) == "C" + IF "<" $ type + IF "" $ type + lBold := .T. + cOut+= "" + ENDIF + IF "" $ type + lItalic := .T. + cOut+= "" + ENDIF + IF "" $ type + lULine := .T. + cOut+= "" + ENDIF + IF "" $ type + lEm := .T. + cOut+= "" + ENDIF + IF "" $ type + lStrong := .T. + cOut+= "" + ENDIF + + ENDIF +ENDIF + +cOut += str + +IF lBold + cOut+= "" +ENDIF +IF lItalic + cOut+= "" +ENDIF +IF lULine + cOut+= "" +ENDIF + +IF lStrong + cOut+= "" +ENDIF +IF lEm + cOut+= "" +ENDIF +if Font != nil .or. Size !=Nil .or. color != Nil +cOut += "" +endif +FWrite( ::nH, cOut+CRLF() ) + +RETURN Self + + + + +/**** +* +* Html():paragraph() +* +* +* +*/ + +METHOD Paragraph( lStart, cAlign, cStyle ) CLASS Html +LOCAL cStr := "'+ ; + CRLF() ) +ELSE +FWrite( ::nH, CRLF()+; + '
'+ ; + CRLF() ) +ENDIF + +RETURN Self + + + +/**** +* +* Html():PutHeading() +* +* Put an HTML heading ( large text ) +*/ + +METHOD PutHeading( cText, nWeight, lCentered ) CLASS Html +DEFAULT nWeight := 3 +DEFAULT lCentered := .F. + +IF lCentered +FWrite( ::nH, "
" ) +ENDIF + +FWrite( ::nH, ""+cText+""+CRLF() ) + +IF lCentered +FWrite( ::nH, "
" ) +ENDIF + +RETURN Self + + + + +/**** +* +* Html():putTextURL() +* +* Put a text link. +*/ + +METHOD PutTextUrl( cText , cUrl , cOnClick, cOnMsOver, cOnMsout, cTarget , font, clr, size, style, bld,lbreak,cClass) CLASS Html + +LOCAL cStr := "" +DEFAULT cUrl := "" +DEFAULT bld := .F. + +FWrite( ::nH, ; + ''+cStr ) + IF font != NIL .or. clr != NIL .or. size != NIL .or. style != NIL + FWrite (::nH,; + '') +Endif +IF bld + FWrite (::nH,; + '') +Endif + +FWrite( ::nH, ; + ''+if(lBreak,'
'+CRLF(),CRLF() )) + + +RETURN Self + + + + +/**** +* +* Html():putImageURL() +* +* Put an Image link. +*/ + +Method PutImageUrl( cImage, nBorder, nHeight, cUrl, ; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak,cClass) CLASS Html +LOCAL cStr := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"' +CRLF() +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"' +CRLF() +ENDIF +IF nBorder != NIL + cStr += " border = "+if(valtype(nBorder)=="N",NUMTRIM(nBorder),nBorder) +CRLF() +ENDIF +IF nHeight != NIL .and. valtype(nHeight)=="N" + cStr += " height = "+NUMTRIM(nHeight) + " " +CRLF() +ELSEIF nHeight != NIL .and. valtype(nHeight)=="C" + cStr += " height = "+nHeight +" " +CRLF() +ENDIF + +IF nWidth!= NIL .and. valtype(nWidth)=="N" + cStr += " width = "+NUMTRIM(nWidth) + " " +CRLF() +ELSEIF nWidth!= NIL .and. valtype(nWidth)=="C" + cStr += " width = "+nWidth + " " +CRLF() +endif +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' +CRLF() +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' +CRLF() +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"' +CRLF() +ENDIF + +IF cTarget != NIL +cStr += ' TARGET='+cTarget +CRLF() +ENDIF + +FWrite( ::nH, ; + ''+ if(lBreak,'
'+CRLF(),"" )) + +RETURN Self + +Method PutTextImageUrl( cImage, nBorder, nHeight, cUrl, ; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak,cClass,cText) CLASS Html +LOCAL cStr := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"' +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"' +ENDIF +IF nBorder != NIL + cStr += " border = "+NUMTRIM(nBorder) +ENDIF +IF nHeight != NIL .and. valtype(nHeight)=="N" + cStr += " height = "+NUMTRIM(nHeight) + " " +ELSEIF nHeight != NIL .and. valtype(nHeight)=="C" + cStr += " height = "+nHeight +" " +ENDIF + +IF nWidth!= NIL .and. valtype(nWidth)=="N" + cStr += " width = "+NUMTRIM(nWidth) + " " +ELSEIF nWidth!= NIL .and. valtype(nWidth)=="C" + cStr += " width = "+nWidth + " " +endif +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"' +ENDIF + +IF cTarget != NIL +cStr += ' TARGET='+cTarget +ENDIF + +FWrite( ::nH, ; + ''+cText+ ''+ if(lBreak,'
'+CRLF(),"" )) + +RETURN Self + + + +/**** +* +* Html():putImage() +* +* Put an Image. +*/ + +Method PutImage( cImage, nBorder, nHeight, ; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak) CLASS Html +LOCAL cStr := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"' +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"' +ENDIF +IF nBorder != NIL .and. valtype(nBorder)=="N" + cStr += " BORDER = "+NUMTRIM(nBorder) +ELSEIF nBorder != NIL .and. valtype(nBorder)=="C" + cStr += " BORDER = "+ '"'+nBorder+'"' +ENDIF + +IF nHeight != NIL .and. valtype(nHeight)=="N" + cStr += " HEIGHT = "+NUMTRIM(nHeight) + " " +ELSEIF nHeight != NIL .and. valtype(nHeight)=="C" + cStr += " HEIGHT = "+'"'+nHeight + '"' +ENDIF +IF nWidth!= NIL .and. valtype(nWidth)=="N" + cStr += " width = "+NUMTRIM(nWidth) + " " +ELSEIF nWidth!= NIL .and. valtype(nWidth)=="C" + cStr += " width = "+nWidth + " " +endif + +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"' +ENDIF + +IF cTarget != NIL +cStr += ' TARGET="'+cTarget+'"' +ENDIF +FWrite( ::nH, ; + ''+if(lBreak,'
'+CRLF(),"" ) ) + +RETURN Self + + + + + +/**** +* +* Html():Close() +* +* Close an HTML disk file +* +*/ + +METHOD Close() CLASS Html +FWrite( ::nH, ""+CRLF() ) +FWrite( ::nH, ""+CRLF() ) +FClose( ::nH ) +RETURN Self + + +/**** +* +* Html():CGIClose() +* +* Close a CGI-HTML stream file +*/ + +METHOD cgiClose() CLASS Html +FWrite( ::nH, ""+CRLF() ) +FWrite( ::nH, ""+CRLF() ) +FWrite( ::nH, CRLF() ) +RETURN Self + + + +/**** +* +* Html():defineTable() +* +* Start an HTML table definition. +* +* +*/ + +METHOD DefineTable( nCols, nBorder, nWidth, nHeight, ColorFore, ColorBG, ; + l3d, lRuleCols, lRuleRows, cClrDark, cClrLight,cClrBorder, ; + nCellPadding, nCellSpacing,cAling,lRules,bgImage,cStyle) CLASS Html + +LOCAL cStr := ""+ CRLF()+CRLF()+"', "")+""+CRLF() +//cStr += cHead + ''+""+CRLF() + +FWrite(::nH, cStr ) + +RETURN Self + + + +/**** +* +* Html():newTableRow() +* +* Start a table row definition. +* +*/ + +METHOD NewTableRow( cColor ) CLASS Html +LOCAL cStr := SPACE(5)+""+CRLF() ) +RETURN Self + + + + +/**** +* +* Html():newTableCell() +* +* Start a table cell definition. +* +*/ + +METHOD NewTableCell( cAlign, cColor, ; + cFont, nSize, cFntColor, nHeight, ; + cBgPic, nWidth, lWrap, ; + nColspan, nRowspan,cValign ,clrdrk,clrlt,cBdrClr,cClass) CLASS Html + +LOCAL cStr := SPACE(10)+"" + ELSE + cStr += ">" + ENDIF + ::lFont:=.t. +ENDIF + +FWrite(::nH, cStr ) +RETURN Self + + + +/**** +* +* Html():endTableCell() +* +* End a table cell definition. +* +*/ + +METHOD EndTableCell() CLASS Html +if ::lFont +FWrite(::nH, ""+CRLF() ) +else +FWrite(::nH, ""+CRLF() ) +endif +::lFont:=.f. +RETURN Self + + + + +/**** +* +* Html():endTable() +* +* End a table definition. +*/ + +METHOD EndTable() CLASS Html +FWrite(::nH, "
"+CRLF() ) +FWrite(::nH, CRLF()+""+ CRLF()+CRLF() ) +RETURN Self + + + + + +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +// FORMS... +//컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + + +/**** +* +* Html():newForm() +* +* Creates a new form +* +*/ + +METHOD NewForm( cMethod, cAction, cName ) CLASS Html + +DEFAULT cMethod := "POST" +DEFAULT cName := "newForm" + +FWRITE( ::nH, CRLF()+"'+CRLF() ) + +scForm := cName + +RETURN Self + + + +/**** +* +* Html():FormGet() +* +* Adds a form edit field +* +*/ + +METHOD FormGet( cType, cName, xValue, nSize ) CLASS Html +default cType := "edit" + +FWrite( ::nH, '" ) +RETURN Self + + + +/**** +* +* Html():FormSubmit() +* +* Adds a form submit button +* +*/ + +METHOD FormSubmit( cText ) CLASS Html +FWrite( ::nH, ''+CRLF() ) +RETURN Self + + + + + +/**** +* +* Html():FormImage() +* +* Adds a form image button +* +*/ + +METHOD FormImage( cText, name, File ) CLASS Html +FWrite( ::nH, ''+CRLF() ) +RETURN Self + + +/**** +* +* Html():FormReset() +* +* Adds a reset button +* +*/ + +METHOD FormReset( cText ) CLASS Html + +FWrite( ::nH, ''+CRLF() ) + +RETURN Self + + + + +/**** +* +* Html():pushButton() +* +* Insert a standalone push button and assign an action to it +* Either pass onClick or cCgiApp - not both +*/ + +METHOD PushButton( cName, cCaption, ; + cCgiApp,; + cOnClick, ; + cOnFocus, cOnBlur, ; + cOnMsOver, cOnMsOut,; + style, id ) CLASS Html + +LOCAL cStr := CRLF()+"" ) + +RETURN Self + + + +/**** +* +* Html():Button() +* +* Insert a standalone "+CRLF() ) +RETURN Self + + + + +/**** +* +* Html():Marquee() +* +* Display a scrolling marquee effect +* +*/ + +METHOD Marquee( cText, cFont, cFntColor, nFntSize, ; + cAlign, nWidth, nHeight, cbgColor, ; + cBehavior, cDirection , ; + nScrollAmt, nScrollDelay, loop,; + onMsOver, onMsOut, onClick, onStart, onFinish ) CLASS Html + + +LOCAL cStr := "" + +DEFAULT cFont := "Verdana" +DEFAULT cFntColor := "white" +DEFAULT nFntSize := 3 +DEFAULT cAlign := "middle" +DEFAULT nWidth := 100 +DEFAULT cText := "" +DEFAULT cBgColor := "black" +DEFAULT cBehavior := "scroll" // "slide" "alternate" +DEFAULT cDirection := "left" // "slide" "alternate" +DEFAULT nScrollAmt := 5 +DEFAULT nScrolldelay := 2 +DEFAULT loop := 0 + +::StartFont( cFont,,,, nFntSize, cFntColor ) + +FWrite( ::nH, '') +FWrite( ::nH, cText ) + +FWrite( ::nH, ""+CRLF() ) +// FWrite( ::nH, cStr ) +::EndFont() + +RETURN Self + + + +/**** +* +* Html():StartMarquee() +* +* Start a scrolling marquee effect definition +* +*/ + +METHOD StartMarquee( cFont, cFntColor, nFntSize, ; + cAlign, nWidth, nHeight, cbgColor, ; + cBehavior, cDirection , ; + nScrollAmt, nScrollDelay, loop, ; + onMsOver, onMsOut, onClick, onStart, onFinish ) CLASS Html + +LOCAL cStr := "" + +DEFAULT cFont := "Verdana" +DEFAULT cFntColor := "white" +DEFAULT nFntSize := 3 +DEFAULT cAlign := "middle" +DEFAULT nWidth := 100 +DEFAULT cBgColor := "black" +DEFAULT cBehavior := "scroll" // "slide" "alternate" +DEFAULT cDirection := "left" // "slide" "alternate" +DEFAULT nScrollAmt := 5 +DEFAULT nScrolldelay := 2 +//DEFAULT loop := -1 + +::StartFont( cFont,,,, nFntSize, cFntColor ) + +cStr += ''+; + CRLF() + +FWrite( ::nH, cStr ) +::EndFont() + +RETURN Self + + +/**** +* +* Html():endMarquee() +* +* +* +*/ + +METHOD EndMarquee() CLASS Html +FWrite( ::nH, ""+CRLF() ) +RETURN Self + + + + +/**** +* +* Html():iFrame() +* +* Define an inline frame. +* +*/ + +METHOD iFrame( name, src, border, marginwidth, marginheight, ; + scrolling, align, width, height) CLASS Html + +LOCAL cStr := "