Module cInternetSessionBusinessProcess.pkg
1//****************************************************************************
2//
3// $File name : cInternetSessionBusinessProcess.pkg
4// $Author : Janne Wassberg
5// $System : VDF Internet Server
6// Created : 97-10-01 @ 17.27.59
7//
8// Confidential Trade Secret.
9// Copyright 1999 Data Access Corporation, Miami FL, USA
10// All Rights reserved
11// DataFlex is a registered trademark of Data Access Corporation.
12//
13//
14// $Description
15//
16//
17// $Rev History
18//
19// MG 1/23/01 Changed return value for DoCall to DF error messages.
20//
21// JJT 10/2/00 Added Get ddValue, Send SetddValue, changed ddValue to ddHndValue
22// -----------------------
23// JW 1999-02-01 Changed DoMessage to take 6 params insted of 3 params, not in the documentation!!!!
24//
25// JJT 1998-11-11 Change Error_report to pass three params. Check that package
26// revision is at least 5.0.6
27//
28// JW 1998-10-31 Added a new Procedure Set CookieAttribute
29// This function allows you to set the attributes of a cookie
30//
31// JW 1998-10-31 Added a new Procedure Set Cookie
32// This function allows you to set a key of a cookie
33//
34// JW 1998-10-31 Added a new Function Cookie
35// This function allows you to get a key of a cookie
36//
37// JW 1998-10-31 Added a new Function ServerVariable
38// This function allows you to get all variables in the ServerVariables collection on IIS
39// like ALL_HTTP, LOCAL_ADDR ............
40//
41// JJT 1998-09-15 Added/changed support for ReportAllErrors, ReportLastError, ClearErrors
42// ErrorCount, ReportErrorItem, ErrorQueueStart, ErrorQueueEnd, FileFieldErrorItem
43// Changed Errors to call LogErrorEvent (gens error and event error)
44// Added better debugging for DfFunc (reports errors back to html and logs em)
45// JJT 1998-09-08 Add HtmlEncodeNoCRLF support for ddValue text edit controls
46// JJT 1998-08-27 Changed interface support (GET_doProcess, DDGetValue, DoDFFunc)
47// JJT 1998-08-06 Added support to ShowEntryError_State when sending field_entry.
48// JJT 1998-08-05 Added test code to change "" to " for non-text field values (more still needed)
49// JW 1998-07-19 Removed null termination in Copy_StringtoVDFISData
50//
51// JW 1998-07-19 Changed an expression in AllocVDFISData_pData
52//
53// JW 1998-07-12 Changed all critical memory errors to use
54// the property for event logging
55//
56// JW 1998-07-08 Added a new function DoGetHtmlQueryString
57// Retreives variables from ASP
58//
59// JW 1998-07-08 Added a new procedure DoLogEvent
60// For event logging in the administrator
61//
62// JW 1998-07-08 VDF Internet Server Version 0.8-215
63//
64// JW 1998-06-27 Source Merge for Internet by Janne Wassberg
65//
66// JW 1998-06-27 Version 0.8-201
67//
68// JW 1998-03-10 Version 110
69//
70// JW 1998-02-18 Version 105
71//
72// JW 1997-10-01 File header created.
73//
74//****************************************************************************
75
76 Validate_Packages 9 0 0
77
78Use cRemoteEntryProcess.pkg // Adds RemoteEntryProcess class
79Use cVdfInternetSession.pkg
80Use cCallInterface.pkg
81Use cCallInterfaceHelper_mixin.pkg
82
83// We will use this to run an Eval without generating an
84// error to the normal DF error handler. Used to convert a
85// message name (e.g. msg_bell) into a message number
86// The only interface is EvalInit
87
88Object oEvalObj Is An cObject
89 Procedure Error_Report Integer ErrNum Integer Err_Line String ErrMsg
90 End_Procedure
91
92 Function EvalInt String sMessage Returns Integer
93 Integer iMess
94 Integer hWasError
95
96 Move Error_Object_Id To hWasError
97 Move Self To Error_Object_Id
98 [err] Indicate err False
99 Move (Integer(Eval(sMessage))) To iMess
100 [err] Move 0 To iMess
101 Move hWasError To Error_Object_Id
102 Function_Return iMess
103 End_Function
104End_Object
105
106
107//
108// This creates a remoteEntryProcess class that can talk to
109// an InternetSession object. This provides the interface needed
110// to connect the BPO to ISO. This class adds the layer to support
111// communications between the ISO and BPO class
112//
113{ ClassLibrary=WebApp ClassType=Abstract }
114{ HelpTopic=cInternetSessionBusinessProcess }
115Class cInternetSessionBusinessProcess Is An cRemoteEntryProcess
116
117 Procedure Construct_Object
118 String sWpoName
119 Forward Send Construct_Object
120
121 // This will only happen if there is a programming class bug
122 If (ghInetSession=0) Begin
123 Error DFERR_PROGRAM C_$MissingISO
124 Abort
125 End
126
127 // register BPO
128 //JW,SF:Linux Must be compiled with S Sympbol since Object_Label is a function
129 Get Object_Label To sWpoName
130 Send Set_Wpo_Data To ghInetSession sWpoName self
131
132
133 // if false, use call interface that is registered. If true use
134 // eval to determine message if not found in interface (good for debuggin)
135 { Category=Behavior }
136 { PropertyType=Boolean }
137 Property Integer pbUseOpenEvalInterface False
138 { Category=Behavior }
139 Property String psDescription ''
140
141 { Visibility=Private }
142 Property String psChangedFields ''
143 { Visibility=Private }
144 Property Integer piUseChanged False // for internal use only
145 // this is maintained by the system and is used by DDHndValue to determine if
146 // a ddValue should be HtmlEncoded. ddValue called by the ASP/JSP always set this true. ddValue
147 // called within your WBO do not. If you want encoded in you app, either use HtmlEncode(xx) or
148 // call ddValueEncode. If you augment ddHndValue, you can get this value to determine if you should
149 // encode or not. Never set it.
150 { Visibility=Private }
151 Property Integer pbEncodeDDValue False
152
153 // creates call interface object and message support for this class including
154 // register interface.
155 // all access is through property phoCallInterface
156 Send DefineCallInterfaceHelper_mixin
157 // Tells callInterface to do datatype conversions with XML data
158 Set pbConvertXML to False
159 End_Procedure //Construct_Object
160
161 Import_class_protocol cCallInterfaceHelper_mixin
162
163 Function DoGetHtmlQueryString String lpszVariable Returns String
164 String sVal
165 Get HtmlQueryString Of ghInetSession lpszVariable To sVal
166 Function_Return sVal
167 End_Function
168
169 Procedure LogEvent Integer iEventType String lpszEvent
170 Send LogEvent To ghInetSession iEventType lpszEvent
171 End_Procedure
172
173
174
175 // Create augmentation messages that will properly redirect
176 // requests tween the ISO and this object.
177 //
178 // ---(redirect to ISO)---->
179 // Send RequestSetFileRowIds
180 // Send RequestSetFileRecords
181 // Send RequestSetFileFieldValues
182 // Send ClearErrors
183 // Send ReportAllErrors
184 // Get hasErrors
185 // Get Search_File_Name
186 // Get Search_Field_Name
187
188 // redirect request to ISO. As of 11.0, this finds all Recnums and RowIds
189 { Visibility=Private }
190 Procedure RequestFileRecords
191 Send RequestFileRecords To ghInetSession self // Get all Recnums from ASP (errors are possible)
192 End_Procedure
193
194 // redirect request to ISO
195 // This assumes that there are no errors when this is started!!!!
196 { Visibility=Private }
197 Procedure RequestFileFieldValues
198 Integer hBPO
199 String sChanged
200 If (piUseChanged(Self)) Begin
201 //Get DoGetHTMLFormValue "ChangedStates" to sChanged
202 //Set psChangedFields to sChanged
203 //showln "changed:" sChanged
204 Send SetChangedFields
205 End
206
207 Move Self To hBPO
208 Send RequestFileFieldValues To ghInetSession hBPO // Get all field field values from ASP (errors are possible)
209 End_Procedure
210
211 // redirect request to ISO
212 Procedure ClearErrors
213 Send ClearErrors To ghInetSession
214 End_Procedure
215
216 // redirect request to ISO
217 // redirect to ISO object. This is a good augmentation point which would allow
218 // the BPO to determine how the errors should be displayed.
219 Procedure ReportAllErrors String sHeader
220 String sText
221 If Num_Arguments Gt 0 Move sHeader To sText
222 Else Move "" To sText
223 Send ReportAllErrors To ghInetSession sText
224 End_Procedure
225
226 // redirect to ISO
227 Procedure ReportErrorItem Integer iItem
228 Send ReportErrorItem To ghInetSession iItem
229 End_Procedure
230
231 // redirect to ISO
232 Procedure ReportLastError Integer bClearError
233 Send ReportLastError To ghInetSession bClearError
234 End_Procedure
235
236 // Redirect to ISO
237 Function ErrorCount Returns Integer
238 Function_Return (ErrorCount(ghInetSession))
239 End_Function
240
241 // see if error exists for this file and field. If it does, return the
242 // item number, else return -1. This can be used to see if a field had an error
243 // in DF or within ASP
244 Function FileFieldErrorItem Integer iFile Integer iField Returns Integer
245 Function_Return (FileFieldErrorItem(ghInetSession,iFile,iField))
246 End_Function
247
248 Function ErrorMessage Integer iItem Returns String
249 Function_Return (ErrorMessage(ghInetSession,iItem))
250 End_Function
251
252 Procedure ErrorQueueStart
253 Send ErrorQueueStart To ghInetSession
254 End_Procedure
255
256 Procedure ErrorQueueEnd
257 Send ErrorQueueEnd To ghInetSession
258 End_Procedure
259
260 Procedure LogErrorEvent Integer iErr String sText
261 Send LogErrorEvent To ghInetSession iErr sText
262 End_Procedure
263
264 // Pass these properties to ISO. This makes it easier to debug
265
266 { MethodType=Property }
267 Function pbVerboseErrors Returns Integer
268 Function_Return (pbVerboseErrors(ghInetSession))
269 End_Function
270
271 // Note that the default property values listed here. They are actually
272 // passed to the ISO object so they don't have defaults in each WO. If we
273 // defined defaults the studio would assume that removing a set statement would
274 // properly set a value to its default and this may not be the case. It is best to
275 // leave the defaults as undefined.
276
277 { MethodType=Property }
278 { Category="Error Handling" }
279 { PropertyType=Boolean }
280 Procedure Set pbVerboseErrors Integer bState
281 Set pbVerboseErrors Of ghInetSession To bState
282 End_Procedure
283
284 { MethodType=Property }
285 Function pbQueueErrors Returns Integer
286 Function_Return (pbQueueErrors(ghInetSession))
287 End_Function
288
289 { MethodType=Property }
290 { Category="Error Handling" }
291 { PropertyType=Boolean }
292 Procedure Set pbQueueErrors Integer bState
293 Set pbQueueErrors Of ghInetSession To bState
294 End_Procedure
295
296 { MethodType=Property }
297 Function pbAllErrorstoEventLog Returns Integer
298 Function_Return (pbAllErrorstoEventLog(ghInetSession))
299 End_Function
300
301 { MethodType=Property }
302 { Category="Error Handling" }
303 { PropertyType=Boolean }
304 Procedure Set pbAllErrorsToEventLog Integer bState
305 Set pbAllErrorstoEventLog Of ghInetSession To bState
306 End_Procedure
307
308 { MethodType=Property }
309 Function pbAllErrorsToLocal Returns Integer
310 Function_Return (pbAllErrorstoLocal(ghInetSession))
311 End_Function
312
313 { MethodType=Property }
314 { Category="Error Handling" }
315 { PropertyType=Boolean }
316 Procedure Set pbAllErrorsToLocal Integer bState
317 Set pbAllErrorstoLocal Of ghInetSession To bState
318 End_Procedure
319
320 { MethodType=Property }
321 Function pbAllErrorsToHtml Returns Integer
322 Function_Return (pbAllErrorsToHtml(ghInetSession))
323 End_Function
324
325 { MethodType=Property }
326 { Category="Error Handling" }
327 { PropertyType=Boolean }
328 Procedure Set pbAllErrorsToHtml Integer bState
329 Set pbAllErrorsToHtml Of ghInetSession To bState
330 End_Procedure
331
332 // In this class we pass filenames and field names and must make the
333 // needed conversion. These two procedures will provide this functionality by sending
334 // a message to the ISO asking it to handle this for us. These are good augmentation
335 // points
336 Function Search_File_Name String sFileName Returns Integer
337 Function_Return (Search_File_Name(ghInetSession,sFileName))
338 End_Function
339
340 Function Search_Field_Name Integer iFile String sFieldName Returns Integer
341 Function_Return (Search_Field_Name(ghInetSession,iFile,sFieldName))
342 End_Function
343
344 // <---(from ISO)----
345 // OnSetFileFieldValue sFile sField sValue
346 // OnSetFileRecord sFile sRecordId
347 // The logic for these procedures already exist in a super-class. All the
348 // ISO has to do is to remeber to call them.
349
350 // returns error code: 0=ok
351
352 // This is a very old Interface which is called when you do a DoProcess call from ASP.
353 // The preferred method has *always* been to use Call. So don't use this.
354 { Visibility=Private Obsolete=True }
355 Function DoProcess Integer iParam String sParam1 Returns Integer
356 End_Function
357
358
359 Function DoGetHtmlFormValue String sFormName Returns String
360 String sVal
361 Address pForm pData
362 Integer bKeepAlive iTemp
363
364 Get HtmlFormValue Of ghInetSession sFormName To pForm
365 Get Copy_VDFISDATAtoString pForm To sVal
366
367 //Cleanup memory
368 If (pForm) Begin
369
370 Get VDFISData_pData pForm To pData
371 Move (DeRefDW(pForm, VDFISData.bKeepAlive)) To bKeepAlive
372 If ( (pData) And (Not(bKeepAlive)) );
373 Move (Free(pData)) To iTemp
374 Move (Free(pForm)) To iTemp
375 End
376 Function_Return sVal
377 End_Function
378
379 // Get current field value. Prior to WebApp/3 this always returned an html encoded value. Now
380 // an extra param determines if this should be done. This was a private message so this change should
381 // not effect existing applications.
382 Function DDCurrentValue Integer hMain Integer iFile Integer iField Returns String
383 String sValue
384 Integer iType
385 Address pFieldData
386
387 Get_Attribute DF_FIELD_TYPE Of iFile iField To iType
388
389 If (iType=DF_TEXT or iType=DF_BINARY) Begin
390
391 // If here, its a text field or binary field!
392
393 // get pointer to Text from DD. (this is not a copy)
394 Get File_Field_Current_Pointer_Value Of hMain iFile iField To pFieldData
395 Move pFieldData To sValue // copy to a string
396 If iType Eq DF_TEXT Begin
397 If (pbEncodeDDValue(self)) ;
398 Get HTMLEncodeNoCrLf sValue To sValue // convert to HTML
399 End
400 End
401 Else Begin
402 // if Number, date or string. These are all short and we can use strings
403 // must find a string and then make a copy to the heap.
404 Get File_Field_Current_Value Of hMain iFile iField To sValue
405 If (pbEncodeDDValue(self)) ;
406 Get HTMLEncode sValue To sValue // convert to HTML
407 End
408 Function_Return sValue
409 End_Function
410
411 // Get current RowId value in serialized format. Called from WebApp using ddValue
412 // Note that we pass the actual owner DDO
413 { Visibility=Private }
414 Function DDRowIdValue Integer hoDD Returns String
415 RowId riCurrentRowId
416 String sValue
417 Get CurrentRowId of hoDD to riCurrentRowId
418 Move (SerializeRowId(riCurrentRowId)) to sValue
419 Function_Return sValue
420 End_Function
421
422
423 // This can be an augmentation point to handle different iOptions and sParams
424 // as needed. Currently we only handle iOption=0 to get current field value
425 Function DDHndValue Integer hMain Integer iFile Integer iField Integer iOption String sParam Returns String
426 String sValue
427 // The false param means No HTML encoding. This message is overridden in a super-class where this is changed
428 If iOption Eq 0 ;
429 Get DDCurrentValue hMain iFile iField False To sValue
430 Function_Return sValue
431 End_Function
432
433 // Set current field value as if entered via kbd (set changed_state, capslock, autofind, etc.)
434 Procedure SetDDCurrentValue Integer hMain Integer iFile Integer iField String sValue
435 Set File_Field_Entry Of hMain iFile iField (pbShowEntryError(Self)) To sValue // pass string to DD
436 End_Procedure
437
438 // This can be an augmentation point to handle different iOptions and
439 // as needed. Currently we only handle iOption=0 to get current field value
440 Procedure SetDDHndValue Integer hMain Integer iFile Integer iField Integer iOption String sValue
441 integer iMainFile hDD
442 // We want to protect against the case where the file passed is a child of the mainDD. In
443 // such a case we will consider this to be non-foriegn by reassigning main to the child. This
444 // way, if someone tries to set a child of a mainDD it will be more forgiving and treat the
445 // change as non-foregin. We need to rethink how DDs treat children of main DDs (currently
446 // treated as foreign)
447 Get Main_file of hMain to iMainFile
448 If (iFile<>iMainFile) Begin // if main file, not this file, see if a parent or child
449 Get Which_Data_Set of hMain iFile to hDD // This only looks up the tree (parents)
450 // if zero, this is a child or not in the structue at all. Find the child DDO and set it to main.
451 If (hDD=0) Begin
452 Get Data_set of hMain iFile to hMain
453 if (hMain=0) procedure_return // this should not happen, it's already been tested for this
454 end
455 end
456 If (iOption=0) ;
457 Send SetDDCurrentValue hMain iFile iField sValue
458 End_Procedure
459
460
461 //
462 // This is the same interface used by the external ASP/JSP call and can be used inside of a WBO to
463 // return all the same ddValue messages
464 //
465 // private, Use DDValue or DDValueEncode
466 { Visibility=Private }
467 Function DDValueExec String sFileField Integer iOpt String sPrm Returns String
468 String sValue sFile sField sParam
469 Integer iPos iFile iField iOption
470 Handle hMain hDD
471
472 // Provide default Option and Param values if they are not passed
473 Move (If(num_arguments<=1, 0, iOpt)) To iOption
474 Move (If(num_arguments<=2, "", sPrm)) To sParam
475
476 // parse "file.field" into file and field strings
477 Move (Pos(".",sFileField)) To iPos
478 If (iPos=0) ;
479 Send LogErrorEvent DFERR_WEBAPP_FILEFIELD_NAME_NOT_FOUND (SFormat(C_$InvalidFileFieldinDdValue,sFileField))
480 Else Begin
481
482 Move (Left(sFileField,iPos-1)) To sFile
483 Move (Mid(sFileField,255,iPos+1)) To sField
484 Get Main_DD To hMain
485
486 If hMain Begin // error will have already been declared if no hMain
487 Get MaptoFileNumber sFile sField To iFile // also return (ERR)
488 If (iFile > 0) ;
489 Get MaptoFieldNumber iFile sField To iField
490
491 // We send this to Main-DD. This allows us to support Foreign field logic
492 If (iFile>0 And iField>=0) begin
493 Get Data_Set of hMain iFile to hDD
494 If (hDD=0) Begin
495 Send LogErrorEvent DFERR_WEBAPP_DDO_NOT_FOUND_FOR_FILE (SFormat(C_$CouldNotFindDDForFileName, sFile))
496 End
497 else begin
498 Get DDHndValue hMain iFile iField iOption sParam To sValue
499 End
500 end
501 End
502 End
503 Indicate Err as (iFile=0 Or iField<0 Or hDD=0) // set error indicator
504 Function_Return sValue // returns the ddValue
505 End_Function
506
507 // This is used to get normal data from a DD. It does not HtmlEncode any of the returned data
508 // unless the option is of a type that only makes sense if it is encoded (e.g. ddForm).
509 Function DDValue String sFileField Integer iOpt String sPrm Returns String
510 string sVal
511 Set pbEncodeDdValue to false
512 If (num_arguments<2) Get DDValueExec sFileField to sVal
513 else If (num_arguments<3) Get DDValueExec sFileField iOpt to sVal
514 else Get DDValueExec sFileField iOpt sPrm to sVal
515 Function_return sVal
516 End_Function
517
518 // This is a short cut message. It returns your ddValue data html encoded saving you the trouble
519 // of having to an HtmlEncode(xx). Useful with Web reports.
520 Function DDValueEncode String sFileField Integer iOpt String sPrm Returns String
521 string sVal
522 Set pbEncodeDdValue to true
523 If (num_arguments<2) Get DDValueExec sFileField to sVal
524 else If (num_arguments<3) Get DDValueExec sFileField iOpt to sVal
525 else Get DDValueExec sFileField iOpt sPrm to sVal
526 Function_return sVal
527 End_Function
528
529
530 Procedure SetDDValue String sFileField String sValue
531 String sFile sField
532 Integer iPos iFile iField
533 handle hDD hMain
534 Integer iOption // for now, it is zero.
535 // parse "file.field" into file and field strings
536 Move (Pos(".",sFileField)) To iPos
537 If (iPos=0) ;
538 Send LogErrorEvent DFERR_WEBAPP_FILEFIELD_NAME_NOT_FOUND (SFormat(C_$InvalidFileFieldinSetDdValue,sFileField))
539 Else Begin
540
541 Move (Left(sFileField,iPos-1)) To sFile
542 Move (Mid(sFileField,255,iPos+1)) To sField
543 Get Main_DD To hMain
544
545 If hMain Begin // error will have already been declared if no hMain
546 Get MaptoFileNumber sFile sField To iFile // also return (ERR)
547 If (iFile > 0) ;
548 Get MaptoFieldNumber iFile sField To iField
549
550 // We send this to Main-DD. This allows us to support Foreign field logic
551 If (iFile>0 And iField>=0) begin
552 Get data_set Of hMain iFile To hDD
553 If (hDD=0) Begin
554 Send LogErrorEvent DFERR_WEBAPP_DDO_NOT_FOUND_FOR_FILE (SFormat(C_$CouldNotFindDDForFileName, sFile))
555 End
556 Else begin
557 Send SetDDHndValue hMain iFile iField iOption sValue
558 end
559 end
560 End
561 End
562 Indicate Err as (iFile=0 Or iField<0 Or hDD=0) // set error indicator
563 Function_Return sValue // returns the ddValue
564 End_Function
565
566
567
568 //
569 // Get FileField Value from DD and place it in pValue pointer to VDFISData structure
570 //
571 { Visibility=Private }
572 Function DoGetDDValue String sFile String sField Integer iOption String sParam Address pVDFISData Returns Integer
573 Address pData
574 Integer iField iFile iOldSize iLen
575 Handle hMain hDD
576 String sValue
577 Boolean bIsRowId
578
579 // when ddValue is called from ASP or JSP it should always be encoded for HTML/WML. If you want to bypass
580 // this you can use the call interface and directly call ddValue (which will not encode) or ddValueEncoded (which will)
581 Set pbEncodeDdValue to true
582
583 Get Main_DD To hMain
584
585 If hMain Eq 0 Function_Return 1 // error should already be declared
586
587 Get MaptoFileNumber sFile sField To iFile // also return (ERR)
588
589 If (iFile > 0) begin
590 // if we accept "rowid" as a special value
591 If (lowercase(sField)="rowid") begin
592 Move True to bIsRowId
593 Move 0 to iField // we just need a valid field (will not be used)
594 end
595 else begin
596 Get MaptoFieldNumber iFile sField To iField
597 end
598 end
599
600 // We send this to Main-DD. This allows us to support Foreign field logic
601 If (iFile>0 And iField>=0) Begin
602 Get data_set Of hMain iFile To hDD
603 If (hDD=0) Begin
604 Send LogErrorEvent DFERR_WEBAPP_DDO_NOT_FOUND_FOR_FILE (SFormat(C_$CouldNotFindDDForFileName, sFile))
605 End
606 Else Begin
607 if bIsRowId begin
608 Get DDRowIdValue hDD To sValue // notice we pass actual owner DD so we don't need to pass the file
609 Get Copy_StringtoVDFISData sValue pVDFISData To pData // must create memory and copy string to it
610 end
611 else begin
612 // make sure arg size is ok for this field. For now we want local string to
613 // be 2x the size of the field. hopefully arg size is already set large and
614 // no change occurs here
615 Get_Attribute DF_FIELD_LENGTH Of iFile iField To iLen
616 Move (iLen * 2) To iLen
617 Get_Argument_Size To iOldSize
618 If iOldSize Lt iLen Set_Argument_Size iLen
619
620 Get DDHndValue hMain iFile iField iOption sParam To sValue
621 Get Copy_StringtoVDFISData sValue pVDFISData To pData // must create memory and copy string to it
622 If iOldSize Lt iLen Set_Argument_Size iOldSize // restore arg size if needed
623 end
624 end
625 End
626
627 Indicate Err as (iFile=0 Or iField<0 Or hDD=0) // set error indicator
628 Function_Return (Err)
629
630 End_Function
631
632 { Visibility=Private }
633 Function ChangedFields Returns String
634 String sChanged
635 Get psChangedFields To sChanged
636 Function_Return sChanged
637 End_Function
638
639 Procedure SetChangedFields
640 String sChanged
641 Get DoGetHTMLFormValue "ChangedStates" To sChanged
642 Set psChangedFields To sChanged
643 End_Function
644
645
646 // Check if passed field is changed. This assumes that the internal properly
647 // psChangedField has been properly loaded with the changed-state form value from the
648 // asp file.
649 // Return values: -2 = changed field string does not exist (error)
650 // -1 = changed field string does not contain file/field value (error)
651 // 0 = field is not changed
652 // 1 = field is changed
653 Function IsFieldChanged String sFile String sField Returns Integer
654 Integer iChanged iPos
655 String sChanged
656 Get ChangedFields To sChanged
657 If (sChanged="") Move -2 To iChanged
658 Else Begin
659 Move (Pos(sfile-"__"-sField,sChanged)) To iPos
660 If Not iPos Move -1 To sChanged
661 Else Move (If(Mid(sChanged,1,iPos-1)="+",1,0)) To iChanged
662 End
663 Function_Return iChanged
664 End_Function
665
666
667 //
668 // Get FileField Value from to VDFISData structure and move it into the DD
669 //
670 { Visibility=Private }
671 Procedure DoSetFileFieldValue String sFile String sField Address pVDFISData
672 String sValue
673 Address pData
674 Integer iField iFile iType iDataLen
675 Integer hMain
676 Integer bShowErr
677 Integer iChanged hdd iUseChanged
678
679 Get Main_DD To hMain
680
681 If hMain Eq 0 Procedure_Return // error should already be declared
682
683 Get MaptoFileNumber sFile sField To iFile // also return (ERR)
684
685 If (iFile > 0) ;
686 Get MaptoFieldNumber iFile sField To iField
687
688 // We send this to Main-DD. This allows us to support Foreign field logic
689 If (iFile>0 And iField>=0) Begin
690
691 Get data_set Of hMain iFile To hDD
692 If (hDD=0) Begin
693 Send LogErrorEvent DFERR_WEBAPP_DDO_NOT_FOUND_FOR_FILE (SFormat(C_$CouldNotFindDDForFileName, sFile))
694 End
695 else begin
696 Get piUseChanged To iUseChanged // 0=No, 1=required, 2=use if available!
697 // we only check for changed state if we'd like to (1 or 2) and we have an existing record
698 // (since new records are always changed).
699 If (iUseChanged>0 And HasRecord(hDD)) Begin
700 Get IsFieldChanged sFile sField To iChanged // return: 0-no, 1-yes, -2,-1=error
701 //Showln "Changed: " sFile " " sField " " iChanged
702 If (iChanged=0) Procedure_Return // nothing changed, we are done...hooray
703 Else If (iChanged<0 And iUseChanged=1) Begin // error and changed checking required!
704 If (iChanged=-2) Error DFERR_WEBAPP_CHANGED_STATE_REQUIRED (SFormat(C_$ChangedStateNotSupported, sFile, sField))
705 Else Error DFERR_WEBAPP_CHANGED_STATE_REQUIRED (SFormat(C_$ChangedStateNotAvailable, sFile, sField))
706 Indicate err True
707 Procedure_Return
708 End
709 End
710 Get_Attribute DF_FIELD_TYPE Of iFile iField To iType
711
712 If (iType=DF_TEXT or iType=DF_BINARY) Begin
713 // If here, its a text field or binary field!
714
715 // this assumes that a DD method will be created to handle this.
716 Get VDFISData_pData pVDFISData To pData // must pass pointer to data
717 Get VDFISData_iDataLen pVDFISData To iDataLen // must pass length of data
718
719 // note that the DD receiving this does not own pData.
720 Set File_Field_Pointer_Entry Of hMain iFile iField iDataLen (pbShowEntryError(Self)) To pData
721 End
722 Else Begin
723
724 // if Number, date or string. These are all short and we can use strings
725
726 // must convert from pointer to a string
727 Get Copy_VDFISDatatoString pVDFISData To sValue
728 Set File_Field_Entry Of hMain iFile iField (pbShowEntryError(Self)) To sValue // pass string to DD
729 End
730 End
731 End
732 Indicate Err as (iFile=0 Or iField<0 or hDD=0) // set error indicator
733 End_Procedure
734
735 // Move Passed record num for fieldname to the appropriate DD.
736 // The remote object should send this message in response to
737 // RequestSetFileRecords
738 //
739 // We expect that this message is sent by the Client (OCX) passing a
740 // filename and file number (we call it ID so we can move away from recnums).
741 // Sets Err if error occurs
742 { Visibility=Private }
743 Procedure DoSetFileRecordId string sFileName string sRecordId
744 integer hDD
745 Get MapFileNametoDD sFileName False to hDD // Must find the file
746 If hDD ;
747 Set Find_record_id of hDD to (integer(sRecordID))
748 Indicate Err as (hDD=0) // set error indicator
749 End_procedure
750
751 { Visibility=Private }
752 Procedure DoSetFileRowId string sFileName string sRowId
753 integer hDD
754 Get MapFileNametoDD sFileName False to hDD // Must find the file
755 If hDD ;
756 Set Find_RowId of hDD to (DeserializeRowId(sRowId))
757 Indicate Err as (hDD=0) // set error indicator
758 End_procedure
759
760
761
762
763 // These messages are used to register and report the Call interface
764
765
766
767 Function ServerVariable String sVariableName Returns String
768 String sVal
769 Address pVar pData
770 Integer iTemp bKeepAlive
771
772 Get HttpServerVariable Of ghInetSession sVariableName To pVar
773 Get Copy_VDFISDATAtoString pVar To sVal
774
775 //Cleanup memory
776 If (pVar) Begin
777
778 Get VDFISData_pData pVar To pData
779 Move (DeRefDW(pVar, VDFISData.bKeepAlive)) To bKeepAlive
780 If ( (pData) And (Not(bKeepAlive)) );
781 Move (Free(pData)) To iTemp
782 Move (Free(pVar)) To iTemp
783 End
784 Function_Return sVal
785 End_Function
786
787 Function Cookie String sCookieName String sCookieKeyName Returns String
788 String sVal
789 Address pVar pData
790 Integer iTemp bKeepAlive
791
792 Get GetCookie Of ghInetSession sCookieName sCookieKeyName To pVar
793 Get Copy_VDFISDATAtoString pVar To sVal
794
795 //Cleanup memory
796 If (pVar) Begin
797
798 Get VDFISData_pData pVar To pData
799 Move (DeRefDW(pVar, VDFISData.bKeepAlive)) To bKeepAlive
800 If ( (pData) And (Not(bKeepAlive)) );
801 Move (Free(pData)) To iTemp
802 Move (Free(pVar)) To iTemp
803 End
804 Function_Return sVal
805 End_Function
806
807 Procedure Set CookieAttribute String sCookieName Date dExpires String sDomain String sPath Boolean bSecure
808 Send SetCookieAttrib Of ghInetSession sCookieName dExpires sDomain sPath bSecure
809 End_Procedure
810
811 Procedure Set Cookie String sCookieName String sCookieKeyName String sValue
812 Send SetCookie Of ghInetSession sCookieName sCookieKeyName sValue
813 End_Procedure
814
815End_Class
816