Module cVdfInternetSession.pkg
1//****************************************************************************
2//
3// $File name : cVdfInternetSession.pkg
4// $File title : DataFlex Internet interface
5// $Author : Janne Wassberg
6// $System : VDF Internet Server
7// Created : 97-10-01 @ 17.27.59
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//
15//
16// $Rev History
17// JJT 8/22/2003 (9.1) removed all Oem/Ansi conversions. Flexcom now does this automatically.
18// JJT 11/1/2000 Built for VDF7
19// JJT 10/2/00 changed to be xHtml compliant (e.g <br> --> <br />
20// added WmlEncode support
21//----------------------
22// JJT 01.09.99 Added messages RequestDDUpdate and RequestFindbyRecid. DFunc now called Call
23//
24// JJT 1999-07-29 Added functions WPO_ID and WPO_Count
25//
26//
27// JJT 1998-11-11 Change Error_report to pass three params
28//
29// JW 1998-10-31 Merged latest OCX interface. 4 new Function/Procdures Server variables and cookies
30//
31// JJT 1998-10-14 Fixed rootname to logical name. Errors redirected later
32// JJT 1998-09-15 Redid the Error object. Many changes
33// JJT 1998-08-28 Merged latest OCX interface.
34// Added OEM/ANSI conversion to all required strings
35//
36// JW 1998-07-02 Changed the OCX-interface to be the latest
37//
38// JW 1998-06-27 Source Merge for Internet by Janne Wassberg
39//
40// 97-10-01 File header created.
41// 98-02-18 Version 105
42// 98-03-10 Version 110
43// 1998-06-27 Version 0.8-201
44//
45//****************************************************************************
46
47Use Flexcom20_Base.pkg // Basic flexcom automation only
48Use Set.pkg // set package
49Use VDFISDataStruct.pkg // structure defintion for VDFISdata type
50Use HtmlEncode.pkg // global HTMLEncode Function
51Use WmlEncode.pkg // global WmlLEncode Function
52
53//Global integer for the internet OCX object
54Global_variable Integer ghInetSession
55Move 0 to ghInetSession
56
57Enum_list
58 // values for WebAppEndPointEnvironment in function CurrentWebAppEnvironment
59 Define WebAppEnvNone for 0
60 Define WebAppEnvASP for 1
61 Define WebAppEnvWebService for 2
62End_enum_list
63
64//
65//
66//----------------cWebApp Class for Windows FlexCom Stuff -----------------------------------------------------
67//
68//
69
70// External function so tha app will close in a proper way
71External_Function PostQuitMessage 'PostQuitMessage' User32.dll Integer iExitCode Returns Void_Type
72
73{ Visibility=Private }
74Procedure Exit_WebApplication for cDesktop
75 Integer iRetVal
76 Move (PostQuitMessage(0)) To iRetVal
77End_Procedure
78
79// CLSID: {C7F3BA7F-D36F-45B3-A0F4-87BF45CC507D}
80// IWebAppServerClientSession Interface
81{ ClassLibrary=WebApp Visibility=Private }
82Class cComIWebAppServerClientSession is a Mixin
83
84 Procedure OutputString String lllpszHtml
85 Handle hDispatchDriver
86 Get phDispatchDriver to hDispatchDriver
87 Send PrepareParams to hDispatchDriver 1
88 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszHtml
89 Send InvokeComMethod to hDispatchDriver 1 OLE_VT_VOID
90 End_Procedure
91
92 Procedure OutputHTML String llpszHtml
93 Send OutputString llpszHtml
94 End_Procedure
95
96 Procedure RequestFileRecords Integer llhWbpo
97 Handle hDispatchDriver
98 Get phDispatchDriver to hDispatchDriver
99 Send PrepareParams to hDispatchDriver 1
100 Send DefineParam to hDispatchDriver OLE_VT_I4 llhWbpo
101 Send InvokeComMethod to hDispatchDriver 2 OLE_VT_VOID
102 End_Procedure
103
104 Function HtmlFormValue String lllpszFormName Returns Integer
105 Handle hDispatchDriver
106 Integer retVal
107 Get phDispatchDriver to hDispatchDriver
108 Send PrepareParams to hDispatchDriver 1
109 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszFormName
110 Get InvokeComMethod of hDispatchDriver 3 OLE_VT_I4 to retVal
111 Function_Return retVal
112 End_Function
113
114 Function HtmlQueryString String lllpszVariable Returns String
115 Handle hDispatchDriver
116 String retVal
117 Get phDispatchDriver to hDispatchDriver
118 Send PrepareParams to hDispatchDriver 1
119 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszVariable
120 Get InvokeComMethod of hDispatchDriver 4 OLE_VT_BSTR to retVal
121 Function_Return retVal
122 End_Function
123
124 Procedure LogEvent Integer lliEventType String lllpszEvent
125 Handle hDispatchDriver
126 Get phDispatchDriver to hDispatchDriver
127 Send PrepareParams to hDispatchDriver 2
128 Send DefineParam to hDispatchDriver OLE_VT_I4 lliEventType
129 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszEvent
130 Send InvokeComMethod to hDispatchDriver 5 OLE_VT_VOID
131 End_Procedure
132
133 Function OutputImage String lllpszImageFilename Returns Boolean
134 Handle hDispatchDriver
135 Boolean retVal
136 Get phDispatchDriver to hDispatchDriver
137 Send PrepareParams to hDispatchDriver 1
138 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszImageFilename
139 Get InvokeComMethod of hDispatchDriver 6 OLE_VT_BOOL to retVal
140 Function_Return retVal
141 End_Function
142
143 Function OutputTextFile String lllpszTextFilename Returns Boolean
144 Handle hDispatchDriver
145 Boolean retVal
146 Get phDispatchDriver to hDispatchDriver
147 Send PrepareParams to hDispatchDriver 1
148 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszTextFilename
149 Get InvokeComMethod of hDispatchDriver 7 OLE_VT_BOOL to retVal
150 Function_Return retVal
151 End_Function
152
153 Procedure RequestFileFieldValues Integer llhWbpo
154 Handle hDispatchDriver
155 Get phDispatchDriver to hDispatchDriver
156 Send PrepareParams to hDispatchDriver 1
157 Send DefineParam to hDispatchDriver OLE_VT_I4 llhWbpo
158 Send InvokeComMethod to hDispatchDriver 8 OLE_VT_VOID
159 End_Procedure
160
161 Procedure OutputPlainText String lllpszText
162 Handle hDispatchDriver
163 Get phDispatchDriver to hDispatchDriver
164 Send PrepareParams to hDispatchDriver 1
165 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszText
166 Send InvokeComMethod to hDispatchDriver 9 OLE_VT_VOID
167 End_Procedure
168
169 Function GetCookie String lllpszCookieName String lllpszCookieKeyName Returns Integer
170 Handle hDispatchDriver
171 Integer retVal
172 Get phDispatchDriver to hDispatchDriver
173 Send PrepareParams to hDispatchDriver 2
174 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszCookieName
175 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszCookieKeyName
176 Get InvokeComMethod of hDispatchDriver 10 OLE_VT_I4 to retVal
177 Function_Return retVal
178 End_Function
179
180 Procedure SetCookieAttrib String lllpszCookieName DateTime lldExpires String lllpszDomain String lllpszPath Boolean llbSecure
181 Handle hDispatchDriver
182 Get phDispatchDriver to hDispatchDriver
183 Send PrepareParams to hDispatchDriver 5
184 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszCookieName
185 Send DefineParam to hDispatchDriver OLE_VT_DATE lldExpires
186 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszDomain
187 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszPath
188 Send DefineParam to hDispatchDriver OLE_VT_BOOL llbSecure
189 Send InvokeComMethod to hDispatchDriver 11 OLE_VT_VOID
190 End_Procedure
191
192 Function HttpServerVariable String lllpszVariableName Returns Integer
193 Handle hDispatchDriver
194 Integer retVal
195 Get phDispatchDriver to hDispatchDriver
196 Send PrepareParams to hDispatchDriver 1
197 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszVariableName
198 Get InvokeComMethod of hDispatchDriver 12 OLE_VT_I4 to retVal
199 Function_Return retVal
200 End_Function
201
202 Procedure SetCookie String lllpszCookieName String lllpszCookieKeyName String lllpszValue
203 Handle hDispatchDriver
204 Get phDispatchDriver to hDispatchDriver
205 Send PrepareParams to hDispatchDriver 3
206 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszCookieName
207 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszCookieKeyName
208 Send DefineParam to hDispatchDriver OLE_VT_BSTR lllpszValue
209 Send InvokeComMethod to hDispatchDriver 13 OLE_VT_VOID
210 End_Procedure
211
212 Procedure SetDevelopmentOnly
213 Handle hDispatchDriver
214 Get phDispatchDriver to hDispatchDriver
215 Send InvokeComMethod to hDispatchDriver 14 OLE_VT_VOID
216 End_Procedure
217
218 Procedure OutputData Integer lllpData
219 Handle hDispatchDriver
220 Get phDispatchDriver to hDispatchDriver
221 Send PrepareParams to hDispatchDriver 1
222 Send DefineParam to hDispatchDriver OLE_VT_I4 lllpData
223 Send InvokeComMethod to hDispatchDriver 15 OLE_VT_VOID
224 End_Procedure
225
226 Function CurrentWebAppEnvironment Returns integer // WebAppEndPointEnvironment
227 Handle hDispatchDriver
228 integer retVal
229 Get phDispatchDriver to hDispatchDriver
230 Get InvokeComMethod of hDispatchDriver 16 OLE_VT_I4 to retVal
231 Function_Return retVal
232 End_Function
233
234 Function WebServiceRequestHeaders Returns Integer
235 Handle hDispatchDriver
236 Integer retVal
237 Get phDispatchDriver to hDispatchDriver
238 Get InvokeComMethod of hDispatchDriver 17 OLE_VT_I4 to retVal
239 Function_Return retVal
240 End_Function
241
242 Procedure AddWebServiceResponseHeader Integer lllpData
243 Handle hDispatchDriver
244 Get phDispatchDriver to hDispatchDriver
245 Send PrepareParams to hDispatchDriver 1
246 Send DefineParam to hDispatchDriver OLE_VT_I4 lllpData
247 Send InvokeComMethod to hDispatchDriver 18 OLE_VT_VOID
248 End_Procedure
249
250End_Class
251
252// _IWebAppServerClientSessionEvents Interface
253{ ClassLibrary=WebApp Visibility=Private }
254Class cCom_IWebAppServerClientSessionEvents is a Mixin
255
256 Procedure OnKillSession
257 End_Procedure
258
259 Procedure OnSetFileRecordID Integer llhWbpo String lllpszFile String lllpszRecordID
260 End_Procedure
261
262 // jjt - new--to be added to com object-------------
263 Procedure OnSetFileRowID Integer llhWbpo String lllpszFile String lllpszRowId
264 End_Procedure
265
266 Procedure OnSetFileFieldValue Integer llhWbpo String lllpszFile String lllpszField Integer llpValue
267 End_Procedure
268
269 Procedure OnDDValue String lllpszWPO String lllpszFile String lllpszField Integer lliOption String lllpszParam Integer llpValue
270 End_Procedure
271
272 Procedure OnRequestDelete String lllpszWPO String lllpszFile Integer llpValue
273 End_Procedure
274
275 Procedure OnRequestFind String lllpszWPO String lllpszFile String lllpszIndexName Integer lliFindMode Integer llpValue
276 End_Procedure
277
278 Procedure OnRequestSave String lllpszWPO String lllpszFile Integer llpValue
279 End_Procedure
280
281 Procedure OnDoProcess String lllpszWPO Integer lliParam String lllpszParam Integer llpValue
282 End_Procedure
283
284 Procedure OnRequestClear String lllpszWPO String lllpszFile Boolean llbClearAll Integer llpValue
285 End_Procedure
286
287 Procedure OnDFFunc String lllpszWPO Integer llpValue
288 End_Procedure
289
290 Procedure OnRequestFindByRecId String lllpszWPO String lllpszFile String lllpszRecId Integer llpValue
291 End_Procedure
292
293 Procedure OnRequestFindByRowId String lllpszWPO String lllpszFile String lllpszRowId Integer llpValue
294 End_Procedure
295
296 Procedure OnRequestDDUpdate String lllpszWPO String lllpszFile Boolean llbShowErrs Integer lliExtra Integer llpValue
297 End_Procedure
298
299 Procedure OnAttachSession
300 End_Procedure
301
302 Procedure OnDetachSession
303 End_Procedure
304
305 Procedure RegisterComEvents
306 Send RegisterComEvent 1 msg_OnKillSession
307 Send RegisterComEvent 2 msg_OnSetFileRecordID
308 Send RegisterComEvent 3 msg_OnSetFileFieldValue
309 Send RegisterComEvent 4 msg_OnDDValue
310 Send RegisterComEvent 5 msg_OnRequestDelete
311 Send RegisterComEvent 6 msg_OnRequestFind
312 Send RegisterComEvent 7 msg_OnRequestSave
313 Send RegisterComEvent 8 msg_OnDoProcess
314 Send RegisterComEvent 9 msg_OnRequestClear
315 Send RegisterComEvent 10 msg_OnDFFunc
316 Send RegisterComEvent 11 msg_OnRequestFindByRecId
317 Send RegisterComEvent 12 msg_OnRequestDDUpdate
318 Send RegisterComEvent 13 msg_OnAttachSession
319 Send RegisterComEvent 14 msg_OnDetachSession
320 Send RegisterComEvent 15 msg_OnRequestFindByRowId
321 Send RegisterComEvent 16 msg_OnSetFileRowID
322 End_Procedure
323End_Class
324
325// CoClass
326// ProgID: WebAppServer.ClientSession.16.1
327// CLSID: {08E7320F-F6CE-4704-BCD9-8F9306E3C2A3}
328// Visual DataFlex Web Application Server Client Session Class
329{ ClassLibrary=WebApp Visibility=Private }
330Class OLEVDFInetSession is a cComAutomationObject
331 Import_Class_Protocol cComIWebAppServerClientSession
332 Import_Class_Protocol cCom_IWebAppServerClientSessionEvents
333
334 Procedure Construct_Object
335 Forward Send Construct_Object
336 Set psProgID to "{08E7320F-F6CE-4704-BCD9-8F9306E3C2A3}"
337 // we will manually create this control at the last moment as needed.
338 Set peAutoCreate to acNoAutoCreate
339 End_Procedure
340End_Class
341
342
343//**********************************************************************//
344//**********************************************************************//
345
346{ ClassLibrary=WebApp Visibility=Private }
347Class cFileIdsSet Is A set
348 // Set object will contain File Names
349 Procedure Construct_Object
350 Forward Send Construct_Object
351 Object oFileNr Is An Array
352 End_Object
353 End_Procedure
354
355 Procedure Clear_File_Data
356 Send Delete_Data
357 Send Delete_Data of oFileNr
358 End_Procedure
359
360 Function File_Count Returns integer
361 Function_Return (Item_Count(self))
362 End_Function
363
364 Procedure Set_File_Data String sName Integer iFileNr
365 Integer iCount
366 Move (UpperCase(sName)) to sName
367 get find_element sName to iCount // search for Dups
368 If iCount ge 0 ; // if found, we have an error
369 Error 900 (SFormat(C_$FileNameAlreadyExists, sName))
370 Else Begin
371 Get File_Count To iCount
372 Set Value iCount to sName
373 Set Value of oFileNr iCount to iFileNr
374 End
375 End_Procedure
376
377 Function File_RootName Integer iItem Returns String
378 Function_Return (Value(self,iItem))
379 End_Function
380
381 Function File_Nr Integer iItem Returns Integer
382 Function_Return (Value(oFileNr(self),iItem))
383 End_Function
384
385 Function Search_File_Item String sName Returns integer
386 Function_Return (find_element(self, Uppercase(sName)))
387 End_Function
388
389 // ret: 0 if not found, else file number of file
390 Function Search_File_Name String sName Returns Integer
391 integer iItm
392 Get Search_File_Item sName to iItm // ret: -1 or item #
393 Function_Return ( if(iItm=-1, 0, File_nr(self,iItm)) )
394 End_Function
395
396 Procedure Initialize_Files
397 integer iFile
398 string sname
399 Send Clear_File_Data
400 Move 0 To iFile
401 Repeat
402 Get_Attribute Df_File_Next_Used Of iFile To iFile
403 If iFile eq 0 Break
404 Get_Attribute Df_File_Logical_Name Of iFile To sName
405 Send Set_File_Data sName iFile
406 Loop
407 End_Procedure
408
409 // Search_Field_Name provides a way of getting the
410 // field Name without generating an error. We will use an error
411 // handle in this object to "swallow" the error.
412 Procedure Error_Report integer iErrNum integer iErrLine string sErrMsg
413 Indicate Err True
414 End_Procedure
415
416 Function Search_Field_Name integer iFile string sFieldName Returns integer
417 integer hOldErr iField
418 If iFile eq 0 Function_return 0
419 Move Error_Object_id to hOldErr // push error handler
420 Move self to Error_Object_Id // redirect here, it is silent!
421 Indicate Err false //
422 Field_Map iFile sFieldName To iField // this could gen an error, we will trap it here
423 Move hOldErr to Error_object_id // pop old error handler
424 Function_Return (if( (Err), -1, iField))
425 End_Function
426
427End_Class
428
429
430//**********************************************************************//
431
432{ ClassLibrary=WebApp Visibility=Private }
433Class cWpoIdsSet Is A Set
434
435 Procedure Construct_Object
436 Forward Send Construct_Object
437 // names are stored in the Set Object
438 // Ids are stored in the oWpoID array
439 Object oWpoID Is An Array
440 End_Object
441 End_Procedure
442
443 Procedure Clear_Wpo_Data
444 Send Delete_Data
445 Send Delete_Data of oWpoID
446 End_Procedure
447
448 Function Wpo_Count Returns integer
449 Function_Return (Item_Count(self))
450 End_Function
451
452 Procedure Set_Wpo_Data String sWpoName Integer iWpoID
453 Integer iCount
454 Move (UpperCase(sWpoName)) to sWpoName
455 get find_element sWpoName to iCount // search for Dups
456 If iCount ge 0 ; // if found, we have an error
457 Error 900 (SFormat(C_$WBONameAlreadyExists, sWpoName))
458 Else Begin
459 Get Wpo_Count To iCount
460 Set Value iCount to sWpoName
461 Set Value of oWpoID iCount to iWpoID
462 End
463 End_Procedure
464
465 Function Wpo_Name Integer iItem Returns String
466 Function_Return (Value(self,iItem))
467 End_Function
468
469 Function Wpo_ID Integer iItem Returns Integer
470 Function_Return (Value(oWpoID,iItem))
471 End_Function
472
473 Function Search_WPO_Item String sWpoName Returns integer
474 Function_Return (find_element(self, Uppercase(sWpoName)))
475 End_Function
476
477 // ret: 0 if not found, else object Id of BPO
478 Function Search_Wpo_ID String sWpoName Returns Integer
479 integer iItm
480 Get Search_WPO_Item sWpoName to iItm // ret: -1 or item #
481 Function_Return ( if(iItm=-1, 0, Wpo_Id(self,iItm)) )
482 End_Function
483
484End_Class
485
486// The cVDFInternetSession class is considered private. All WBOs talk to this
487// by sending messages to the ghInetSession handle but this entire interface is
488// is private. All public access is defined in the WBOs and in the cWebApp object
489//
490
491{ ClassLibrary=WebApp Visibility=Private }
492Class cVDFInternetSession is a OLEVDFInetSession
493
494 Procedure Construct_Object
495 integer hErr
496 Forward Send Construct_Object
497
498 Move self to ghInetSession
499
500 // when errors are reported should technical info be provided. If set
501 // to true you get Error#, Line#, File# and Field#
502 { Category="Error Handling" }
503 { PropertyType=Boolean }
504 Property Integer pbVerboseErrors False
505
506 // When True, VDF errors are queued. This should be set
507 // indirectly with ErrorQueueStart and ErrorQueueEnd
508 { Category="Error Handling" }
509 { PropertyType=Boolean }
510 Property Integer pbQueueErrors False
511
512 // If true, ALL errors are recorded in the event log. This
513 // is good for debugging. If false only appropriate error
514 // are event logged
515 { Category="Error Handling" }
516 { PropertyType=Boolean }
517 Property Integer pbAllErrorsToEventLog False
518
519 // If true, errors are directed to the VDF error handler. This
520 // means an error will pop up on your VDF program. Normally not
521 // wanted for the web, but this can be useful when debugging at
522 // the server
523 { Category="Error Handling" }
524 { PropertyType=Boolean }
525 Property Integer pbAllErrorsToLocal False
526
527 // If false, no errors will be sent to the HTML client.
528 // Normally, this should be true. Might be useful when debugging
529 { Category="Error Handling" }
530 { PropertyType=Boolean }
531 Property Integer pbAllErrorsToHtml True
532
533
534 Enum_list // note that these can be IORed together
535 Define C_hoNormal for 1
536 Define C_hoFile for 2
537 Define C_hoConsole for 4
538 End_Enum_list
539
540 Define C_HtmlOutputFileChannel for 9
541
542 { Category=Behavior }
543 { EnumList="C_hoNormal, C_hoFile, C_hoConsole" }
544 Property Integer peHtmlOutput C_hoNormal
545 Property String psHtmlOutputFileName "WebAppHtmlOut.txt"
546 Property integer pbFirstTimeOpen False
547
548 // used to prevent recursion in LogEvent method
549 Property Integer pbPrivateInLogEvent false
550
551 Object oFileIds is a cFileIdsSet
552 End_Object
553
554 // list of wbos (for asp)
555 Object oWpoIds Is A cWpoIdsSet
556 End_Object
557
558
559 // list of wsos (for web-service)
560 Object oWsoIds Is A cWpoIdsSet
561 End_Object
562
563 Send Initialize_Files of oFileIds
564
565 End_Procedure
566
567 // needed for backwards compatibility (private)
568 Procedure PreSetFileRecordID Integer lpDispParams
569 End_Procedure
570
571// // when OCX is created, set up error redirection. We do this as
572// // late as possible. (Occurs when activate sent to panel)
573// // This used to be called PostCreateOCX
574// Procedure OnCreate
575// Forward send OnCreate
576// End_Procedure
577
578 //Procedure Search_Wpo_ID string sWebBPO Returns Integer
579 // returns: Object ID of BPO, zero if not found
580 Function Search_Wpo_ID String sWebBPO Returns Integer
581 Function_Return (Search_Wpo_ID( oWpoIds , sWebBPO))
582 End_Procedure
583
584 // Add WPO to the list
585 Procedure Set_Wpo_Data String sWpoName Integer iWpoID
586 Send Set_Wpo_Data of oWpoIds sWpoName iWpoID
587 End_procedure
588
589 // return Id of WBP object for item
590 Function Wpo_ID Integer iItem Returns Integer
591 Function_Return (Wpo_ID(oWpoIds,iItem))
592 End_Function
593
594 // get number of WBP items
595 Function Wpo_Count Returns integer
596 Function_Return (Wpo_Count(oWpoIds))
597 End_Function
598
599
600 // Same as above, but used for web services!
601
602 //Procedure Search_Wpo_ID string sWebBPO Returns Integer
603 // returns: Object ID of BPO, zero if not found
604 Function Search_Wso_ID String sWebBPO Returns Integer
605 Function_Return (Search_Wpo_ID( oWsoIds , sWebBPO))
606 End_Procedure
607
608 // Add WPO to the list
609 Procedure Set_Wso_Data String sWpoName Integer iWpoID
610 Send Set_Wpo_Data of oWsoIds sWpoName iWpoID
611 End_procedure
612
613 // return Id of WBP object for item
614 Function Wso_ID Integer iItem Returns Integer
615 Function_Return (Wpo_ID(oWsoIds,iItem))
616 End_Function
617
618 // get number of WBP items
619 Function Wso_Count Returns integer
620 Function_Return (Wpo_Count(oWsoIds))
621 End_Function
622
623
624 //
625 // Field and field string to integer conversion functions
626 //
627 Function Search_File_Name String sName Returns Integer
628 Function_Return (Search_file_Name( oFileIds, sName))
629 End_Function
630
631 Function Search_Field_Name integer iFile String sFieldName Returns Integer
632 Function_Return (Search_field_Name( oFileIds, iFile, sFieldName))
633 End_Function
634
635 // This will be good for augmentation allowing us to handle
636 // not finding the WBPO any way we want.
637 //
638 Function MapWPONametoID string sWPO Returns integer
639 Integer hWPO
640
641 Get Search_WPO_ID sWPO to hWPO
642
643 If hWPO eq 0 Begin // an error here
644 // This will get reported in HTML and in event log
645 Error DFERR_WEBAPP_WBO_NOT_FOUND (SFormat(C_$WBONotFound, sWpo))
646 end
647 Function_Return hWPO
648 End_Function
649
650 // This will be good for augmentation allowing us to handle
651 // not finding the WSO any way we want.
652 //
653 Function MapWSONametoID string sWPO Returns integer
654 Integer hWPO
655
656 Get Search_WSO_ID sWPO to hWPO
657
658 If hWPO eq 0 Begin // an error here
659 // This will get reported in HTML and in event log
660 Error DFERR_WEBAPP_WBO_NOT_FOUND (SFormat(C_$WBONotFound, sWpo))
661 end
662 Function_Return hWPO
663 End_Function
664
665
666 // place error code within VDFISData structure
667 Procedure DoSetVDFISData_Error Address pVDFISData integer iError
668 integer bOK
669 Move (Storedw(pVDFISData, VDFISData.dwError, iError)) to bOK
670 End_Procedure
671
672 //
673 // These events are sent by the OCX and must be directed to the WBPO
674 //
675
676 Procedure OnKillSession
677 Send Exit_WebApplication to Desktop
678 End_Procedure
679
680 // This object's container (cWebApp) must understand these
681 // DoAttach and Detach messages.
682 Procedure OnAttachSession
683 Delegate Send DoAttachProcess
684 End_Procedure
685
686 Procedure OnDetachSession
687 Delegate Send DoDetachProcess
688 End_Procedure
689
690
691//-------------OnRequestSave---------
692
693 Procedure OnRequestSave String sWebBpo string sFile address pVDFISData
694 Integer hObjId iError
695 Get MapWPONametoID sWebBpo To hObjId // will generate an error if not found
696 If hObjId ;
697 Get DoRequestSave of hObjId sFile to iError
698 Else ;
699 Move 1 to iError // JJT: Create error num for BPO not found
700 Send DoSetVDFISData_Error pVDFISData iError
701 End_Procedure
702
703//-------------OnRequestDelete---------
704
705 Procedure OnRequestDelete String sWebBpo string sFile address pVDFISData
706 Integer hObjId iError
707 Get MapWPONametoID sWebBpo To hObjId // will generate an error if not found
708 If hObjId ;
709 Get DoRequestDelete of hObjId sFile to iError
710 Else ;
711 Move 1 to iError // JJT: Create error num for BPO not found
712 Send DoSetVDFISData_Error pVDFISData iError
713 End_Procedure
714
715//-------------OnRequestClear---------
716
717 Procedure OnRequestClear String sWebBpo string sFile integer bClearAll address pVDFISData
718 Integer hObjId iError
719 Get MapWPONametoID sWebBpo To hObjId // will generate an error if not found
720 If hObjId ;
721 Get DoRequestClear of hObjId sFile bClearAll to iError
722 Else ;
723 Move 1 to iError // JJT: Create error num for BPO not found
724 Send DoSetVDFISData_Error pVDFISData iError
725 End_Procedure
726
727//-------------OnRequestFind---------
728
729 Procedure OnRequestFind String sWebBpo string sFile string sField integer iFindMode Address pVDFISData
730 Integer hObjId
731 integer iError
732 Get MapWPONametoID sWebBpo To hObjId // will generate an error if not found
733 If hObjId ;
734 Get DoRequestFind of hObjId sFile sField iFindMode to iError
735 Else ;
736 Move 1 to iError // JJT: Create error num for BPO not found
737 Send DoSetVDFISData_Error pVDFISData iError
738 End_Procedure
739
740//-------------OnDoProcess---------
741
742 Procedure OnDoProcess String sWebBpo integer iParam string sParam1 address pVDFISData
743 Integer hObjId iError
744 Get MapWPONametoID sWebBpo To hObjId // will generate an error if not found
745 If hObjId ;
746 Get DoProcess of hObjId iParam sParam1 to iError
747 Else ;
748 Move 1 to iError // JJT: Create error num for BPO not found
749 Send DoSetVDFISData_Error pVDFISData iError
750 End_Procedure
751
752//-------------OnSetFielFieldValue---------
753
754 Procedure OnSetFileFieldValue Integer hObjId String sFile String sField Address pVDFISData
755 If hObjId ;
756 Send DoSetFileFieldValue To hObjId sFile sField pVDFISData
757 End_Procedure
758
759//-------------OnSetFileRecordId---------
760
761 Procedure OnSetFileRecordId Integer hObjId String sFile String sRecordId
762 If hObjId ;
763 Send DoSetFileRecordId to hObjId sFile sRecordId
764 End_Procedure
765
766//-------------OnSetFileRowId---------
767 Procedure OnSetFileRowId Integer hObjId String sFile String sRowId
768 If hObjId ;
769 Send DoSetFileRowId to hObjId sFile sRowId
770 End_Procedure
771
772
773//-------------OnDDValue---------
774
775 Procedure OnDDValue String sWebBpo String sFile String sField DWORD iOption String sParam Address pVDFISData
776 Integer hObjId iError
777 Get MapWPONametoID sWebBpo To hObjId // will generate an error if not found
778 If hObjId ;
779 Get DoGetDDValue of hObjId sFile sField iOption sParam pVDFISData to iError
780 Else ;
781 Move 1 to iError // JJT: Create error num for BPO not found
782 Send DoSetVDFISData_Error pVDFISData iError
783 End_Procedure
784
785//-------------OnDFFunc---------
786
787// Note that DfFunc and Call both map to this location. From this point on, it is Call
788// This can be called as part of a webapp or a web-service. We must check and only
789// pass these messages to the correct objects
790 // values for WebAppEndPointEnvironment in function CurrentWebAppEnvironment
791 Procedure OnDFFunc string sWebBpo Address pVDFISData
792 Integer hObjId iError
793 Integer eWebAppEndPointEnvironment
794 Get CurrentWebAppEnvironment to eWebAppEndPointEnvironment
795 If (eWebAppEndPointEnvironment=WebAppEnvASP) Begin
796 Get MapWPONametoID sWebBpo To hObjId // will generate an error if not found
797 end
798 Else If (eWebAppEndPointEnvironment=WebAppEnvWebService) Begin
799 Get MapWSONametoID sWebBpo To hObjId // will generate an error if not found
800 end
801 // It really can't be none, but if it is, the id will be 0 anyway
802 If hObjId ;
803 Get DoCall of hObjId pVDFISData to iError
804 Else ;
805 Move 1 to iError // JJT: Create error num for BPO not found
806 Send DoSetVDFISData_Error pVDFISData iError
807 End_Procedure
808
809//-------------OnRequestFindByRecId---------
810
811 Procedure OnRequestFindByRecId String sWBO String sFile String sRecId Address pVDFISData
812 Integer hObjId iError
813 Get MapWPONametoID sWBO To hObjId // will generate an error if not found
814 If hObjId ;
815 Get DoRequestFindByRecId of hObjId sFile sRecId to iError
816 Else ;
817 Move 1 to iError // JJT: Create error num for BPO not found
818 Send DoSetVDFISData_Error pVDFISData iError
819 End_Procedure
820
821//-------------OnRequestFindByRowId---------
822
823 Procedure OnRequestFindByRowId String sWBO String sFile String sRowId Address pVDFISData
824 Integer hObjId iError
825 Get MapWPONametoID sWBO To hObjId // will generate an error if not found
826 If hObjId ;
827 Get DoRequestFindByRowId of hObjId sFile sRowId to iError
828 Else ;
829 Move 1 to iError // JJT: Create error num for BPO not found
830 Send DoSetVDFISData_Error pVDFISData iError
831 End_Procedure
832
833//-------------OnRequestDDUpdate---------
834
835 Procedure OnRequestDDUpdate String sWBO String sFile Boolean bShowErrs DWORD iExtra Address pVDFISData
836 Integer hObjId iError
837 Get MapWPONametoID sWBO To hObjId // will generate an error if not found
838 If hObjId ;
839 Get DoRequestDDUpdate of hObjId sFile bShowErrs iExtra to iError
840 Else ;
841 Move 1 to iError // JJT: Create error num for BPO not found
842 Send DoSetVDFISData_Error pVDFISData iError
843 End_Procedure
844
845 // As of 9.1, we no longer Augment messages that require OEM/ASNI translation.
846 // Flexcom now does this for us. This only affects string parameters.
847 // Note that all data passed through VDFISData already is properly converted
848
849 Procedure OutputHTMLtoTestFile string sHtml
850 string sFile
851 get psHtmlOutPutFileName to sFile
852 If (sFile<>"") begin
853 If (not(pbFirstTimeOpen(self))) begin
854 Direct_Output channel C_HtmlOutputFileChannel sFile
855 Set pbFirstTimeOpen to True
856 end
857 else ;
858 Append_Output channel C_HtmlOutputFileChannel sFile
859 end
860 Write Channel C_HtmlOutputFileChannel sHtml
861 Close_Output channel C_HtmlOutputFileChannel
862 end_Procedure
863
864 Procedure OutputHtml string sHtml
865 integer iOut
866 Get peHtmlOutput to iOut
867 If (iOut IAND C_hoNormal) ;
868 Forward Send OutputHtml sHtml
869 If (iOut IAND C_hoConsole) ;
870 Showln sHtml
871 If (iOut IAND C_hoFile) ;
872 Send OutPutHtmltoTestFile sHtml
873 End_Procedure
874
875 Procedure OutputPlainText String sText
876 integer iOut
877 Get peHtmlOutput to iOut
878 If (iOut IAND C_hoNormal) ;
879 Forward Send OutputPlainText sText
880 If (iOut IAND C_hoConsole) ;
881 Showln sText
882 If (iOut IAND C_hoFile) ;
883 Send OutPutHtmltoTestFile sText
884 End_Procedure
885
886
887 // augment to check for recursion as well as do ansi conversion
888 Procedure LogEvent Integer iEventType String sEvent
889 // Do this to prevent recursion. If an error occurs inside of this method
890 // the error handler may try to send LogEvent causing recursion.
891 // This will stop that
892 If (pbPrivateInLogEvent(self)) Procedure_return
893
894 Set pbPrivateInLogEvent to True
895 Forward Send LogEvent iEventType sEvent
896 Set pbPrivateInLogEvent to False
897 End_Procedure
898
899
900 Function HtmlQueryString String sVariable Returns String
901 String sRet
902 Forward Get HtmlQueryString sVariable to sRet
903 Function_Return sRet
904 End_Function
905
906 Function HtmlFormValue String sFormName Returns DWORD
907 DWORD lretVal
908 Forward Get HtmlFormValue sFormName to lretval
909 Function_Return lretVal
910 End_Function
911
912 // Error Interface:
913
914 // ReportError and ReportErrorEvent is private and should never be sent. It is sent
915 // from within the error handler object to report errors
916 Procedure ReportError integer iErr string sErrMsg integer iLine integer iFileNr integer iFieldNr
917 String sLineBreak sDtl
918 String sFileName sFieldName
919 Get HtmlEncode sErrMsg to sErrMsg
920 Move "
" To sLineBreak
921 // The extended error message will contain \n to mark end of line. We will
922 // convert these to HTML style.
923 Move (Replaces("\n",sErrMSg,sLineBreak)) to sErrmsg
924 If (pbVerboseErrors(self)) Begin
925 Move (SFormat(C_$VDFErrorInLine, iErr, iLine)) to sDtl
926 If iFileNr gt 0 Move (sDtl * DD_FILE_TEXT * string(iFileNr)) to sDtl
927 If iFieldNr gt 0 Move (sDtl * DD_FIELD_TEXT * string(iFieldNr)) to sDtl
928 Append sErrMsg sLineBreak sDtl
929 End
930 Append sErrMsg sLineBreak sLineBreak
931 Send OutputHTML sErrMsg
932 End_Procedure
933
934 Procedure ReportErrorEvent integer iErr string sErrMsg integer iLine integer iFileNr integer iFieldNr
935 String sHtml sLineBreak sDtl
936 String sFileName sFieldName
937 //Move ". " To sLineBreak
938 Move (Character(13)+Character(10)) to sLineBreak
939 // The extended error message will contain \n to mark end of line. We will
940 // convert these to HTML style.
941 Move (Replaces("\n",sErrMSg,sLineBreak)) to sErrmsg
942 Move (SFormat(C_$VDFErrorInLine, iErr, iLine)) to sDtl
943 If iFileNr gt 0 Move (sDtl * DD_FILE_TEXT * string(iFileNr)) to sDtl
944 If iFieldNr gt 0 Move (sDtl * DD_FIELD_TEXT * string(iFieldNr)) to sDtl
945 Append sErrMsg sLineBreak sDtl
946 Send LogEvent iErr sErrMsg
947 End_Procedure
948
949 // EnumerateErrors and ErrorReportCallBack could be used for
950 // advanced purposes allowing other objects to handle errors in
951 // a more custom fashion.
952
953 // use this to generate a report of all errors
954 Procedure EnumerateErrors integer iMsg integer hObj
955 Send EnumerateErrors to Error_Object_Id iMsg hObj
956 End_procedure
957
958 Procedure ErrorReportCallBack integer iItem integer iMsg integer hObj
959 Send ErrorReportCallBack to Error_Object_Id iItem iMsg hObj
960 End_procedure
961
962 // use this to generate a report of all errors
963 Procedure ReportAllErrors String sErrHdr
964 // if no errors... do nothing
965 If (ErrorCount(Self)) Begin
966 If sErrHdr ne "" ;
967 Send OutputHTML (""-sErrHdr-"
")
968 Send EnumerateErrors MSG_ReportError Self
969 Send OutputHTML "
"
970 End
971 End_procedure
972
973 // Use this to display the last error
974 Procedure ReportLastError Integer bClearError
975 // note: passing -1 means last error (if no last error, nothing happens)
976 Send ErrorReportCallBack -1 MSG_ReportError Self
977 If bClearError ; // should we clear this error after displaying it
978 Send ClearError to Error_Object_Id -1
979 End_Procedure
980
981 // return error for item, return in HTML format
982 Function ErrorMessage integer iItem returns string
983 String sLineBreak sErrMsg
984 Get ErrorMessage of Error_object_id iItem to sErrMsg
985 Get HtmlEncode sErrMsg to sErrMsg
986 Move "
" To sLineBreak
987 Move (Replaces("\n",sErrMSg,sLineBreak)) to sErrmsg
988 Function_Return sErrMsg
989 End_Function
990
991 // This will clear all errors
992 Procedure ClearErrors
993 Send ClearErrors to Error_Object_Id
994 End_Procedure
995
996 // return true if any errors exist in queue
997 Function ErrorCount Returns Integer
998 Function_Return (ErrorCount(Error_object_id))
999 End_Function
1000
1001 // see if error exists for this file and field. If it does, return the
1002 // item number, else return -1.
1003 Function FileFieldErrorItem integer iFile integer iField Returns integer
1004 Function_Return (FileFieldErrorItem(Error_object_id,iFile,iField))
1005 End_Function
1006
1007 // starts a queued errors,
1008 Procedure ErrorQueueStart
1009 Set pbQueueErrors to True
1010 Send ClearErrors
1011 End_Procedure
1012
1013 //ends queued errors. Note that the queue is not cleared
1014 Procedure ErrorQueueEnd
1015 Set pbQueueErrors to False
1016 End_Procedure
1017
1018 // Generate error for pass item
1019 Procedure ReportErrorItem integer iItem
1020 Send ErrorReportCallBack iItem MSG_ReportError Self
1021 End_Procedure
1022
1023 // Generate and error and make sure that it is
1024 // logged in event log.
1025 Procedure LogErrorEvent integer iErr string sText
1026 integer bOldSt
1027 Get pbAllErrorstoEventLog to bOldSt
1028 Set pbAllErrorstoEventLog to True
1029 Error iErr sText
1030 Set pbAllErrorstoEventLog to bOldSt
1031 End_Procedure
1032
1033End_Class
1034
1035