Module DDExtFld.pkg
1//****************************************************************************//
2// //
3// $File name : DDExtFld.pkg //
4// $File title : DD extended field objects //
5// Notice : //
6// $Author(s) : John Tuohy //
7// //
8// //
9// Confidential Trade Secret. //
10// Copyright 1998-1999 Data Access Corporation, Miami FL, USA //
11// All Rights reserved //
12// DataFlex is a registered trademark of Data Access Corporation. //
13// //
14// $Rev History //
15// //
16// JJT 10/18/99 Fixed bug where string of lesser length was not updated //
17// JJT 11/9/98 Added !zb code around conditionally created objects //
18// JT 10/26/98 Added Set Field_pValue //
19// JT 8/6/98 Added bShowErr to Field_pEntry (currently does nothing) //
20// JW 7/10/98 Changed IF test in Field_pEntry where address type //
21// was used to integer type. It dose not work with address //
22// I did also remove some old debug code //
23// //
24// JT 7/9/98 Added passed length to set field_pEntry //
25// JT 6/25/98 Moved into this package. // //
26//****************************************************************************//
27
28// This is used by the DataDictionary class and provides a method for
29// windows DDs (for now) to support local buffers for text and binary buffers.
30// Field objects are created within the DD by sending the message:
31// The DD interface is:
32//
33// Get Field_Object iField to hExtFieldObject
34// Send DefineExtendedField iField
35// Send DefineAllExtendedFields
36// Send ExtendedFieldsUpdate bSave
37// Send ExtendedFieldsRefresh bCleared
38// Set File_Field_Current_Pointer_Value iFile iField iLen to pValue
39// Set Field_Current_Pointer_Value iField iLen to pValue
40// Set File_Field_Pointer_Entry iFile iField iLen bShowErr to pValue
41// Set Field_Pointer_Entry iField iOpts iLen bShowErr to pValue
42// Get File_Field_Current_Pointer_Value iFile iField to pData
43// Get Field_Current_Pointer_Value iField to pData
44//
45// Once object is identified, the following interface can be used
46// Get FieldPointer of hExtFieldObject to iMemoryPointer
47// Get FieldLength of hExtFieldObject to iLen
48// Get File_Number of hExtFieldObject to iFile
49// Get Field_Number of hExtFieldObject to iFile
50// Set Update_Save_State of hExtFieldObject to bState // be careful!
51// Set Update_Find_State of hExtFieldObject to bState // be careful
52// Set FieldRefresh_Save_State of hExtFieldObject to bState // be careful
53//
54
55//
56// DD structure:
57// DD Object (property Field_objects points to child)
58// FieldObjects (array of field#s and field objs)
59// FieldObject1 (heap alloc for each field)
60// FieldObjectn
61//
62
63//
64// This is used to create a single extended field object.
65//
66// Interface
67// Get FieldPointer to iMemoryPointer
68// Get FieldLength to iLen
69// Get File_Number to iFile
70// Get Field_Number to iFile
71// get/Set Update_Save_State to bState // be careful!
72// get/Set Update_Find_State to bState // be careful
73// get/Set FieldRefresh_Save_State to bState // be careful
74// get/set FieldChangedState
75// send defineField iFile iField
76// Send FieldUpdate bSave
77// Send FieldRefresh bCleared
78// Set Field_pEntry iOpts iLen to pValue
79// Set Field_pValue iLen to pValue
80//
81use VDFBase.pkg
82
83{ Visibility=Private ClassLibrary=Common }
84Class FieldObject is an Array
85
86 Procedure Construct_Object
87 Forward send construct_object
88 // these are all set by DefineField and should not be changed
89 Property Integer File_Number 0
90 Property Integer Field_Number 0
91 Property Integer FieldLength 0
92 Property Address FieldPointer 0
93
94 // these can be changed, with care, by the developer
95 Property Integer Update_Save_State True
96 Property Integer Update_Find_State False // usually no point for finds
97 Property Integer FieldRefresh_State True
98 End_procedure
99
100 Procedure set FieldChangedState integer bState
101 integer iField
102 Get Field_Number to iField
103 Delegate Set Field_Changed_state iField to bState
104 end_procedure
105
106 Function FieldChangedState returns integer
107 integer iField bState
108 Get Field_Number to iField
109 Delegate get Field_Changed_state iField to bState
110 Function_return bState
111 end_function
112
113
114 Function CreateFieldHeap integer iFldLen returns Integer
115 Integer bOk
116 Address pField pOldField
117 // The heap must be fieldlength+1. Get_Field_Value with memory pointers
118 // always adds a 0 at the end of the returned value. We will never look at
119 // that extra character which is why we only zero up to iFldLen
120 Get FieldPointer to pOldField
121 If pOldField ;
122 Move (ReAlloc(pOldField, iFldLen+1)) to pField
123 Else ;
124 Move (Alloc(iFldLen+1)) to pField
125 If pField Move (MemSet(pField,0,iFldLen+1)) to bOK
126 Function_return pField
127 End_Function
128
129 Procedure DestroyFieldHeap
130 integer bOK
131 address pField
132 Get FieldPointer to pField
133 if (pField ) ;
134 Move (Free(pField)) to bOk
135 Set FieldPointer to 0
136 End_procedure
137
138 // augment to realse heap allocation
139 Procedure Destroy_Object
140 Send DestroyFieldHeap
141 forward send Destroy_object
142 End_procedure
143
144 // for object: define file, field, fieldlength and allocate heap memory
145 // and set memory pointer
146 Procedure DefineField integer iFile integer iField
147 address pField
148 integer iFldLen
149 Set File_Number to iFile
150 Set Field_Number to iField
151 Get_Attribute DF_FIELD_LENGTH of iFile iField to iFldLen
152 Set FieldLength to iFldLen
153 Get CreateFieldHeap iFldLen to pField
154 Set FieldPointer to pField
155 End_procedure
156
157 // Move from the DD Buffer to the file buffer
158 Procedure FieldUpdate integer bSave
159 Integer iFile iField iFieldLen
160 Address pField
161 integer iType
162
163 // if bSave, part of save which means only update if changed
164 // if not bsave, part of find. You usually would not update this. You
165 // don't index on these types of fields
166 If ( (bSave AND Update_Save_State(self) and FieldChangedState(Self)) OR ;
167 (Not(bSave) And Update_Find_state(Self) ) ) Begin
168 Get FieldPointer to pField
169 Get File_Number to iFile
170 Get Field_Number to iField
171 if (pField AND iFile) Begin
172 // if datatype is Text we want to pass the real text length. Anything else (binary) we pass
173 // the entire thing. Changed for 9.1 (used to pass entire length). This also required a RT change
174 // this code will not work before build 9.1.44.
175 // If binary, we must set a length limit because the heap is one char longer.
176 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
177 If (iType=DF_TEXT) Begin
178 Move (CStringLength(pField)) to iFieldLen
179 End
180 Else Begin
181 Get FieldLength to iFieldLen
182 End
183 Set_Field_Value iFile iField to pField LENGTH iFieldLen
184 end
185 End
186 end_procedure
187
188 // Move from File buffer to local DD Buffer
189 // bCleared determines if this is a find or a clear.
190 Procedure FieldRefresh boolean bCleared
191 integer iFile iField
192 integer bOk
193 Address pField
194 If (FieldRefresh_state(Self)) Begin
195 Get FieldPointer to pField
196 Get File_Number to iFile
197 Get Field_Number to iField
198 // move from file buffer to memory pointed to by pField
199 if (pField AND iFile) Begin
200 If not bCleared Begin
201 Get_Field_Value iFile iField to pField
202 end
203 Else Begin
204 Move (MemSet(pField,0,FieldLength(Self))) to bOk
205 end
206 end
207 End
208 Set FieldChangedstate to False
209 End_Procedure
210
211 Procedure set Field_pEntry integer iOpts integer iLen integer bShowErr Address pValue
212 integer iFile iField iFldLen iMemLen
213 Integer bChanged
214 Address pField
215 integer bOK
216
217 // currently we do nothing with bShowErr because we don't checkfor errors!
218
219 // if No-enter or Displayonly, this shouldn't be changed. For now we will
220 // let NoPut through, since a user might need it for finding.
221 If (iOpts IAND DD_NOENTER) Procedure_Return
222
223 // maybe in the future
224 // Force a caplsock if required
225 //If (iOpts IAND DD_CAPSLOCK) Move (Uppercase(sValue)) to sValue
226
227 Get File_Number to iFile
228 Get Field_Number to iField
229 Get FieldLength to iFldLen // max length of the field buffer
230 Get FieldPointer to pField
231 If (pField AND iFile) Begin
232
233 // always work with the smallest field size. We know the length of the
234 // field buffer and we are passed the length of the data
235 Move (iLen MIN iFldLen) to iMemLen
236 // is there a change??
237 If (pValue) ; // check for empty pointer
238 Move (MemCompare(pField,pValue,iMemLen)) to bChanged
239 // See if new string is shorter than the old one. If it is we might get no change when one exists
240 // So, check if the old Field's next char is 0, if not, the new field is shorter.. and changed,
241 // if the field's next char is 0, then it is at the end and the strings are the same
242 If (Not(bChanged) AND iMemLen<iFldLen) ;
243 Move (derefc(pField, iMemLen)<>0) to bChanged
244
245 If ( bChanged or (iOpts IAND DD_FORCEPUT) ) Begin
246 If (iMemLen<iFldLen) ; // if a partial copy, zero the entire string first
247 Move (MemSet(pField,0,iFldLen)) to bOk
248 If (pValue) ;
249 Move (MemCopy(pField,pValue,iMemLen)) to bOk
250 End
251 // Set changed state if changed and it is not No_put. This
252 // is an improvement on DEOs which would set changed-state for
253 // a no-put. This way, finds use the changed value but saves will
254 // not trigger a phony data loss
255 //If ( bChanged ) ;
256 If ( bChanged AND Not(iOpts IAND DD_NOPUT) ) ;
257 Set FieldChangedState to True
258
259 // The following is really highly unlikely!!!
260 // perform autofinds if needed. Note that required checking will occur as
261 // part of validation.
262 // We will only autofind if the field value is changed. This is consistent with
263 // DEOs which do not autofind on unchanged values. This provides optimizations
264 // when a parent record is already loaded.
265 If (bChanged OR FieldChangedState(self)) Begin
266 If (iOpts IAND DD_AUTOFIND) Delegate Send File_Field_AutoFind iFile iField EQ
267 Else If (iOpts IAND DD_AUTOFIND_GE) Delegate Send File_Field_AutoFind iFile iField GE
268 End
269 end
270
271 End_Procedure
272
273 // Raw update of value.
274 Procedure set Field_pValue integer iLen Address pValue
275 integer iFile iField iFldLen iMemLen
276 Integer bOk
277 Address pField
278 Get File_Number to iFile
279 Get Field_Number to iField
280 Get FieldLength to iFldLen // max length of the field buffer
281 Get FieldPointer to pField
282 If (pField AND iFile) Begin
283 // always work with the smallest field size. We know the length of the
284 // field buffer and we are passed the length of the data
285 Move (iLen MIN iFldLen) to iMemLen
286 // is there a change??
287 If (iMemLen<iFldLen) ; // if a partial copy, zero the entire string first
288 Move (MemSet(pField,0,iFldLen)) to bOk
289 If (pValue) ;
290 Move (MemCopy(pField,pValue,iMemLen)) to bOk
291 end
292 End_Procedure
293End_Class
294
295// This contains all extended field objects.
296// The array contains a list of all objects where item=field#
297// and item+1=field object.
298//
299// Interface is:
300// Get Field_object iField to hFldObj
301// Send DefineFieldObject iField
302// Send ExtendedFieldsUpdate bSave
303// Send ExtendedFieldsRefresh bCleared
304//
305{ Visibility=Private ClassLibrary=Common }
306Class FieldObjects is an Array
307
308 // return object Id for iField. 0 if none.
309 Function Field_Object integer iField Returns integer
310 integer iItm iCnt
311 Get Item_Count to iCnt
312 Move 0 to iItm
313 While iItm lt iCnt
314 If (Value(self,iItm)=iField) ;
315 Function_Return (Value(self,iItm+1))
316 Increment iItm
317 Increment iItm
318 Loop
319 Function_Return 0
320 End_Function
321
322 // define an extended object for field
323 Procedure DefineFieldObject integer iField
324 integer hFld
325 integer iCnt iFile
326 Delegate Get Main_File to iFile
327 Get Field_Object iField to hFld // this shouldn't exist yet
328 If not hFld Begin
329 Get Create U_FieldObject to hFld
330 Send DefineField to hFld iFile iField
331 Get Item_Count to iCnt // add to array
332 Set Value item iCnt to iField // Pos = field#
333 Set Value item (iCnt+1) to hFld // Pos+1 = field object
334 End
335 End_Procedure
336
337 // update all extended fields. Field buffer <-- DD buffer
338 Procedure ExtendedFieldsUpdate integer bSave
339 integer iItm iCnt
340 Get Item_Count to iCnt
341 Move 0 to iItm
342 While iItm lt iCnt
343 Increment iItm
344 Send FieldUpdate to (Value(self,iItm)) bSave
345 Increment iItm
346 Loop
347 End_procedure
348
349 // refresh all extended fields. Field buffer --> DD buffer
350 Procedure ExtendedFieldsRefresh Boolean bCleared
351 integer iItm iCnt
352 Get Item_Count to iCnt
353 Move 0 to iItm
354 While iItm lt iCnt
355 Increment iItm
356 Send FieldRefresh to (Value(self,iItm)) bCleared
357 Increment iItm
358 Loop
359 End_procedure
360
361 //
362 // these are sent from the child field object. We need to direct them
363 // to the DDO (the parent).
364 Procedure set Field_Changed_State integer iField integer bState
365 Delegate Set Field_Changed_state iField to bState
366 end_procedure
367
368 Function Field_Changed_State integer iField returns integer
369 integer bState
370 Delegate get Field_Changed_state iField to bState
371 Function_return bState
372 end_function
373
374 Procedure File_Field_AutoFind integer iFile integer iField integer iMode
375 delegate send File_field_AutoFind iFile iField iMode
376 End_procedure
377
378 Procedure Destroy_Object
379 delegate set Field_Objects to 0
380 Forward Send Destroy_object
381 End_Procedure
382
383End_Class
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473