home *** CD-ROM | disk | FTP | other *** search
- /*
- AFCDataBase custom field: Date by Andrea Galimberti - (C) Brighting Brain Brothers
-
-
- ID: DBFIELD_DATE
-
- OBJECT NAME: dbfdate
-
- CONTENT: string
-
- LENGTH (bytes): 10
-
- INDEX: any
-
- METHODS: all methods available
-
-
- Note: This example of a possible "date" field stores the date in a string
- format. The setv() method only reformats the date using two slash
- characters to separate the day, month and year part (in this order).
- Besides, the date field is searched (indexed or not) using the
- built-in string matching routines: an evident drawback is that the
- year 1998 is different from 98 (!).
-
- Probably, a more useful "date" field will store the date in a
- Julian date format: the string entered by the user may be converted
- automatically by the setv() method; the getv() method may return the
- Julian date number, and the asString() method may reformat this
- number in a string. Doing so, the search for a date is done using the
- built-in number searching routines (DBIDXVALUE_NUMBER, and
- DBSEARCH_NUMBER).
- */
-
- OPT MODULE
- OPT EXPORT
-
- MODULE 'afc/database'
-
- /* our new field type (inherited from dbfield) */
- OBJECT dbfdate OF dbfield PRIVATE
- value:PTR TO CHAR -> this is the place where we are going to store the
- -> field value
- ENDOBJECT
-
- /* the constant identifing our new field type. This is used when the
- end-user adds to his table a field of this type. */
- CONST DBFIELD_DATE="fDAT"
-
-
- -> Constructor and destructor
-
-
- /* The field contructor: note that it is a procedure, not a method */
- PROC builder(tag:PTR TO LONG)
- DEF f=NIL:PTR TO dbfdate
-
- NEW f.dbfield(tag) -> here we call the base-class constructor
- IF f=NIL THEN Raise(DBASE_ERR_NOMEM)
- /* the length of a date field has to be always of 10 bytes, so we
- override the DBFTAG_LENGTH passed in the taglist */
- f.setattrs([DBFTAG_LENGTH,10,NIL,NIL])
- /* we allocate the memory to store the field value*/
- f.value:=String(f.getattr(DBFTAG_LENGTH))
- IF f.value=NIL THEN Raise(DBASE_ERR_NOMEM)
- ENDPROC f -> Important: we return the pointer to the instance of the field
-
- /* The field destructor */
- PROC end() OF dbfdate
-
- /* Dispose the memory allocated for the field value */
- IF self.value THEN DisposeLink(self.value)
- SUPER self.end() -> remember to call the base-class destructor
- ENDPROC
-
-
- -> methods to set/get, write/read the field contents
-
-
- /* The following methods normalize_date() and check_slash() are simply
- functions used by the setv() method to parse and reformat a date */
- PROC normalize_date(s,f,l) OF dbfdate
- DEF d[10]:STRING, m[10]:STRING, y[10]:STRING
- DEF dv=0, mv=0, yv=0, dd=NIL:PTR TO LONG
-
- MidStr(d,s,0,f)
- MidStr(m,s,f+1,l-f-1)
- RightStr(y,s,StrLen(s)-l-1)
- dv:=Val(d)
- mv:=Val(m)
- yv:=Val(y)
-
- dd:=[31,28,31,30,31,30,31,31,30,31,30,31]
- IF mv<1 THEN mv:=1
- IF mv>12 THEN mv:=12
- IF dv<1 THEN dv:=1
- IF dv>dd[mv-1] THEN dv:=dd[mv-1]
- StringF(s,'\z\d[2]/\z\d[2]/\d',dv,mv,yv)
- ENDPROC s
-
- PROC check_slash(s,q) OF dbfdate
- DEF f=0,l=0, left[10]:STRING, right[10]:STRING
- DEF x[10]:STRING
-
- StrCopy(x,s)
- f:=InStr(x,q,0)
- IF f>=0
- l:=InStr(x,q,f+1)
- IF l>=0
- StrCopy(x,self.normalize_date(x,f,l))
- ELSE
- MidStr(left,x,0,f+3)
- RightStr(right,x,StrLen(x)-f-3)
- StringF(x,'\s/\s',left,right)
- l:=f+3
- StrCopy(x,self.normalize_date(x,f,l))
- ENDIF
- ELSE
- StrCopy(x,'')
- ENDIF
- ENDPROC x
-
- /* This sets the field value */
- PROC setv(v) OF dbfdate
- DEF z[10]:STRING, left[10]:STRING, right[10]:STRING
- DEF f=0, l=0
-
- SUPER self.setv(v)
- /* we call strClear to zero all the string bytes (StrCopy(self.value,'')
- will only set the string length to 0) */
- strClear(self.value)
-
- -> here you can do all your processing before storing the value...
-
- StrCopy(z,self.check_slash(v,'/'))
- IF StrCmp(z,'')
- StrCopy(z,self.check_slash(v,'-'))
- IF StrCmp(z,'')
- MidStr(left,v,0,2)
- MidStr(z,v,2,2)
- RightStr(right,v,StrLen(v)-4)
- StringF(v,'\s/\s/\s',left,z,right)
- f:=2
- l:=5
- StrCopy(z,self.normalize_date(v,f,l))
- ENDIF
- ENDIF
-
- StrCopy(self.value,z)
- ENDPROC TRUE -> always return TRUE
-
- /* Returns the contents of the field */
- PROC getv() OF dbfdate IS self.value
-
- /* Clears the contents of the field */
- PROC clear() OF dbfdate
-
- SUPER self.clear()
- strClear(self.value)
- ENDPROC
-
- /* Writes the field contents to the database file */
- PROC write(owner) OF dbfdate
-
- /* Note how we check the return value of the supermethod before writing
- anything to file; then we write DBFTAG_LENGTH bytes from self.value.
- The owner parameter is needed in I/O routines to identify the database
- file to which we are going to write. */
- IF SUPER self.write(owner) THEN self.fwrite(owner,self.value,self.getattr(DBFTAG_LENGTH))
- ENDPROC
-
- /* Reads the field contents from the database file */
- PROC read(owner) OF dbfdate
-
- SUPER self.read(owner)
- /* Read DBFTAG_LENGTH bytes to self.value */
- self.fread(owner,self.value,self.getattr(DBFTAG_LENGTH))
- ENDPROC TRUE -> return FALSE if something went wrong
-
- /* Converts the field contents to a string and stores them in the string
- passed as a parameter */
- PROC asString(s:PTR TO CHAR) OF dbfdate
-
- IF s THEN StrCopy(s, self.value)
- ENDPROC s -> return the same string you received as a parameter
-
-
- -> Index methods
-
-
- /* We store the date as a string, so we specify that the index must be
- searched using the built-in string matching routines (Obviously this
- works if the end-user adds an index for this type of field; otherwise
- the search style is specified by the searchtype() method) */
- PROC idxvaluetype() OF dbfdate IS DBIDXVALUE_STRING
-
- /* This method returns the value to be added to the field index */
- PROC idxvalue() OF dbfdate
- DEF s=NIL
-
- /* We allocate the memory for the index value (string) and copy the
- field contents */
- s:=String(self.getattr(DBFTAG_LENGTH))
- IF s=NIL THEN Raise(DBASE_ERR_NOMEM)
- StrCopy(s, self.value)
- ENDPROC s -> return the index item allocated
-
- /* Free the memory of the index item allocated with the previous method */
- PROC idxdisposevalue(p) OF dbfdate
-
- IF p THEN DisposeLink(p)
- ENDPROC
-
- /* Writes the index value to the index file */
- PROC writeidxvalue(owner, v) OF dbfdate
-
- self.fwrite(owner,v,self.getattr(DBFTAG_LENGTH))
- ENDPROC
-
- /* Reads the index value from the index file */
- PROC readidxvalue(owner) OF dbfdate
- DEF s=NIL
-
- /* We have to allocate the memory to store the index item */
- s:=String(self.getattr(DBFTAG_LENGTH))
- IF s=NIL THEN Raise(DBASE_ERR_NOMEM)
- /* Then we read it from the file */
- self.fread(owner,s,self.getattr(DBFTAG_LENGTH))
- ENDPROC s -> and return the index item just read
-
-
- -> Other methods
-
-
- /* This specifies that if the field is not indexed the database engine uses
- the built-in string matching routines to search for a value */
- PROC searchtype() OF dbfdate IS DBSEARCH_STRING
-
-