Code-Schnipsel [tdbengine.org]

Deutsch

English

Snippets

Home Overview Search Impressum Contact Members


Code snippets

On this page we centre little useful help routines which can can be integreted in youre programs smooth.
If you want to add to our list sometihing don't be shy of sending us youre snippets.

1. Verifying an email address

PROCEDURE isEMail(cEMail : STRING) : BYTE
//check email address format
RETURN Sel(cEMail LIKE '?*@?*.?*')
ENDPROC

this little procedure checks if the transfered string comes up to a typical model of an email address. then the call might look like this:

PROCEDURE checkInput
...
   IF isEMail(GetQueryString("EMail")) = 0 THEN
     CGIWriteLn("ERROR!")
   END
...
ENDPROC

2. Converting a tdbengine date to other date format

PROCEDURE formatDate(nDate : INTEGER) : STRING
// convert Date FROM DD,MM.YYYY TO YYYY/MM/DD
VAR cStandard : STRING = DateStr(nDate)
RETURN cStandard[7,4] +"/"+ cStandard[4,2] +"/"+ cStandard[1,2]
ENDPROC

Example of a call:

...
CGIWriteLn( "Date: " + formatDate( Today -7) ) // for example Date: 2004/04/21
...

3. Closing all opened tables using one call

PROCEDURE closeAllDB
// Closes all open tables
WHILE MaxFile > 0 DO CloseDB(MaxFile) END
ENDPROC

4. Detectind the number of lines of a table

PROCEDURE countLines(fn : STRING) : INTEGER
  VAR i,fh:INTEGER
  fh:=Reset(fn)
  WHILE NOT EOT(fh) DO
    ReadLn(fh)
    i++
  END
  Close(fh)
  RETURN i
ENDPROC

5. Detecting the real designator of a field

The function Label() always transfers the name of the related table in braces at LINK fields. The following procedure avoids it:

PROCEDURE getLabel(dbHANDLE, iFieldNo : INTEGER) : STRING
// get bare field name
VAR c : STRING
RETURN (c := GetStructure(dbHANDLE, iFieldNo))[1,Pos(',',c)-1]
ENDPROC

6. Filling a variable with the value of a CGI parameter of same denominator

Using the following function you can fill a variable with the value of a CGI parameter of same denominator.

PROCEDURE CGIGetParamVar(VAR x : STRING)
// fills X with cgi value
x:=CGIGetParam(VarName(x))
ENDPROC

Example of a call:

PROCEDURE Main
    VAR Username : STRING
    CGIGetParamVar(Username)
    CGIWriteLn("Hallo "+Username)
ENDPROC

7. Displaying REAL data in scientific notation

PROCEDURE RealToExp(x : REAL) : STRING
  VAR l : REAL
  IF x=0 THEN
     RETURN '0.0000000000E0'
  ELSIF Abs(x)>=1 THEN
    l:=Int(Log(Abs(x))/Log(10))
  ELSE
    l:=Int(Log(Abs(x))/Log(10))-1
  END
  RETURN Str(x/Exp(Log(10)*l),1,10)+'E'+str(l)
ENDPROC

8. Displaying INTEGER data in hex

Converts a 16 bit decimal data (0-65536) in hex

PROCEDURE IntToHex(x : INTEGER) : STRING
//converts FROM decimal TO hexadecimal
VAR hs : STRING
hs:='0123456789ABCDEF'
RETURN hs[1+x DIV 4096 MOD 16]+hs[1+x MOD 4096 DIV 256]+hs[1+x MOD 256 DIV 16]+hs[1+x MOD 16]
ENDPROC

9. Detecting a leap year

PROCEDURE isLeapYear( nY : INTEGER ) : INTEGER
// checks the given Year TO be a leap Year
   IF (((nY MOD 4 = 0) AND (nY MOD 100 # 0)) OR (nY MOD 400 = 0))
     RETURN 1
   ELSE
     RETURN 0
   END
ENDPROC

10. Getting CGI parameter independent of METHOD

PROCEDURE GetCGI(cParam : STRING): STRING
// gets a given cgi parameter no matter which METHOD was used
    VAR cRes    : STRING;
    IF cRes := CGIGetParam(cParam) = '' THEN
     cRes := GetQueryString(cParam)
    END
    RETURN cRes
ENDPROC

11. Checking for windows running as operating system.

PROCEDURE isWindows : INTEGER
//checks for win32 as operating system
IF GetEnv("TDB_OS") LIKE "win32" THEN RETURN 1 ELSE RETURN 0 END
ENDPROC

Example of use:

...
IF isWindows
THEN CGIExec("C:\WINDOWS\notepad.exe",0)
ELSE CGIExec("/usr/bin/nano",0)
END
...

12. Is the day x a regular workday?

We got this function from Mr. Sitz. It uses a list of holidays to be able to identify any day of the coming years sa a holiday or as a workday. So assure that you keep INI file list accessible.

PROCEDURE isArbeitstag (date:INTEGER):INTEGER
        /*
           Author: Horst H. Sitz
            ../ini/holiday.ini contains known holidays (see belov)
        */

        VAR n :REAL

        IF LeftStr(DayOfWeek(date),1)='S' THEN //'S'aturday OR 'S'unday
          date:=0
        ELSE
          n:=Val(GetIdent('../ini/holiday.ini','0.n'))+1
          WHILE n--#0,Val(GetIdent('../ini/holiday.ini','0.'+Str(n))+ Str(Year(date)))#date DO END
          IF n=0 THEN
            n:=Val(GetIdent('../ini/holiday.ini',Str(Year(date))+'.n'))+1
            WHILE n--#0,Val(GetIdent('../ini/holiday.ini',Str(Year(date))+'.'+Str(n)))#date DO END
            IF n=0 THEN date:=1 ELSE date:=0 END
          ELSE
            date:=0
          END
        END
        RETURN date
ENDPROC

The holidy.ini file

[0]
#fixed holidys without date!
#n=number of entries
n=7
#New Year
1=1.1.
#May holiday
2=1.5.
#German Unification Day
3=3.10.
#Christmas Eve
4=24.12.
#1.Christmas Day
5=25.12.
#2.Christmas Day
6=26.12.
#New Year's eve
7=31.12.

#In the variable holidays only holidays which aren't on Sunday need TO be absorbed.
#Here with date!
#n=number of entries for Year
[2004]
n=4
#Good Friday
1=9.4.2004
#Easter Monday
2=12.4.2004
#Ascension
3=20.5.2004
#Whit Monday
4=31.5.2004

[2005]
n=4
#Good Friday
1=25.3.2005
#Easter Monday
2=28.3.2005
#Ascension
3=5.5.2005
#Whit Monday
4=16.5.2005

13. Saving the mark list of a table

The following funktion saves the marks of a table into an external file tobe able to load them later.

PROCEDURE saveMarks(db : INTEGER; cDest : STRING) : INTEGER VAR hdl : INTEGER VAR aMarks : TBITS[] InitArray(aMarks[FileSize(db)]) GetMarks(db, aMarks) IF hdl:=F_Create(cDest)>0 THEN F_Write(hdl,aMarks); F_Close(hdl) END RETURN NBits(aMarks) ENDPROC14. Loadind a mark list of a table again

Using this function you can load a mark list saved before.

PROCEDURE restoreMarks(db : INTEGER; cSource : STRING) : INTEGER VAR hdl : INTEGER VAR aMarks : TBITS[]
IF hdl:=F_Open(cSource)>0 THEN F_Read(hdl, aMarks ); F_Close(hdl) END PutMarks(db, aMarks ) RETURN NBits( aMarks )
ENDPROC