Deutsch English
Home
About tdbengine
Newsletter
Download
Helpware
Forum
Chat
Documentation
Basic Course
Function reference
HOWTO...?
Snippets
Projects
Links
Benchmarks
Bug Reporting
Support request
 
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)
ENDPROC

14. 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



See also:





tdbengine Anwendungen im Web:

Open-Source Web CMS


Open-Source Bug-Tracking


Free wiki hosting

Open-Source Wiki-System

Kostenloses Foren-Hosting

Dišt mit tdbengine 8-)

tdbengine chat
irc.tdbengine.org
#tdbengine

   Copyright © 2003-2004 tdb Software Service GmbH
   Alle rechte vorbehalten. / All rights reserved
   Last changed: 12.05.2004
{Fehler für :execmacro{execmacro="sessionspy"}


ranking-charts.de

Programmers Heaven - Where programmers go!