1//*************************************************************************
2//* *
3//* Confidential Trade Secret. *
4//* Copyright (c) 2011-2012 Mertech Data Systems Inc, Miami Florida *
5//* All rights reserved. *
6//* DataFlex is a registered trademark of Data Access Corporation. *
7//* *
8//*************************************************************************
9Use cCrystal.pkg
10Use cCrystalcraxddrt.pkg
11Use cFlex2Crystalcraxddrt.pkg
12Use cFlex2CrystalRAS.pkg
13Use cFlex2CrystalViewer.pkg
14Use msado28.pkg
15
16{ HelpTopic=cFlex2CrystalApplication }
17Class cFlex2CrystalApplication is a cObject
18 Procedure Construct_Object
19
20 { Visibility=Private }
21 Property Handle phoReportObject
22
23 Forward Send Construct_Object
24 End_Procedure
25
26 Function ComOpenReport String llFileName Integer llOpenMethod Returns Variant
27 Handle hoRCD
28
29 Send CreateComObject of (phoReportObject(Self))
30 Send ComOpenReport of (phoReportObject(Self)) llFileName llOpenMethod
31 Get ReportClientDocumentObject of (phoReportObject(Self)) to hoRCD
32 Function_Return (pvComObject(phoReportObject(Self)))
33 End_Function
34
35 Function IsComObjectCreated Returns Boolean
36 Function_Return True // since its not real, it doesn't matter
37 End_Function
38
39 Function ComCanClose Returns Boolean
40 Function_Return True // since its not real, it doesn't matter
41 End_Function
42
43 Procedure ReleaseComObject
44 // stub procedure that is unused
45 End_Procedure
46End_Class
47
48{ HelpTopic=cFlex2CrystalReport }
49Class cFlex2CrystalReport is a cCrystalReport
50 Import_Class_Protocol cFlex2CrystalIReport
51 Import_Class_Protocol cFlex2CrystalIReportEvents
52
53 Procedure Construct_Object
54
55 { Visibility=Private }
56 Property Handle phoDataDefinition
57
58 { Visibility=Private }
59 Property Handle phoReportClientDocument
60
61 { Visibility=Private }
62 Property Handle phoDatabaseClass
63
64 { Visibility=Private }
65 Property Handle phoDatabaseTablesClass
66
67 { Visibility=Private }
68 Property Handle phoParentReport
69
70 { Visibility=Private }
71 Property Handle[] phoTablesClass
72
73 Forward Send Construct_Object
74 Set psProgID to "{0851CF1A-9015-475A-A153-909E0837C836}"
75 Set psEventId to "{DE6B90B4-A19A-4005-8344-D8157619688E}"
76 Set peAutoCreate to acNoAutoCreate
77 End_Procedure
78
79 Procedure ComExport Boolean bPrompt
80 Handle hoSaveDlg hoExport
81 Boolean bSave
82 String sTitle sName sDict
83 Integer iIndex iFileType
84 Integer[10] iExportConstant
85
86 Move OLEF2CExportFormatType_CrystalReport to iExportConstant[0]
87 Move OLEF2CExportFormatType_PortableDocFormat to iExportConstant[1]
88 Move OLEF2CExportFormatType_CharacterSeparatedValues to iExportConstant[2]
89 Move OLEF2CExportFormatType_Excel to iExportConstant[3]
90 Move OLEF2CExportFormatType_ExcelRecord to iExportConstant[4]
91 Move OLEF2CExportFormatType_ExcelWorkbook to iExportConstant[5]
92 Move OLEF2CExportFormatType_WordForWindows to iExportConstant[6]
93 Move OLEF2CExportFormatType_EditableRTF to iExportConstant[7]
94 Move OLEF2CExportFormatType_RichText to iExportConstant[8]
95 Move OLEF2CExportFormatType_Xml to iExportConstant[9]
96
97 If (bPrompt) Begin
98 Get Create U_SaveAsDialog to hoSaveDlg
99 Set Filter_String of hoSaveDlg to ;
100 ('Crystal Reports (*.rpt)|*.rpt|PDF (*.pdf)|*.pdf|' + ;
101 'Character Separated Values (CSV) (*.csv)|*.csv|' + ;
102 'Microsoft Excel (97-2003) (*.xls)|*.xls|' + ;
103 'Microsoft Excel (97-2003) Data-Only (*.xls)|*.xls|' + ;
104 'Microsoft Excel Workbook Data-Only (*.xlsx)|*.xlsx|' + ;
105 'Microsoft Word (97-2003) (*.doc)|*.doc|' + ;
106 'Microsoft Word (97-2003) - Editable (*.rtf)|*.rtf|' + ;
107 'Rich Text Format (RTF) (*.rtf)|*.rtf|XML (*.xml)|*.xml' )
108 Set Dialog_Caption of hoSaveDlg to "Export Report"
109 Set File_Title of hoSaveDlg to (ComReportTitle(Self))
110
111 If (Show_Dialog(hoSaveDlg)) Begin
112 Get File_Name of hoSaveDlg to sName
113 Get Filter_Index of hoSaveDlg to iIndex
114 Send ComExportToDisk iExportConstant[iIndex-1] sName
115 End
116 End
117 Else Begin
118 Send ComExportNative_2 (pvComObject(ExportObject(Self)))
119 End
120 End_Procedure
121
122 // RAS Interface methods
123 { Visibility=Private }
124 Function ReportClientDocumentObject Returns Handle
125 Handle hoRCD
126 Variant vRCD
127
128 If (not(phoReportClientDocument(Self))) Begin
129 If (not(ComIsSubreport(Self))) Begin
130 Get Create U_cFlex2CrystalReportClientDocument to hoRCD
131 Get ComReportClientDocument to vRCD
132 Set pvComObject of hoRCD to vRCD
133 Set phoReportClientDocument to hoRCD
134 End
135 Else Begin
136 Get ReportClientDocumentObject of (phoParentReport(Self)) to hoRCD
137 Set phoReportClientDocument to hoRCD
138 End
139 End
140
141 Function_Return (phoReportClientDocument(Self))
142 End_Function
143
144 { Visibility=Private }
145 Function DatabaseClassObject Returns Handle
146 Handle hoDB
147 Variant vDB
148
149 If (not(phoDatabaseClass(Self))) Begin
150 Get ComDatabase of (ReportClientDocumentObject(Self)) to vDB
151 Get Create U_cFlex2CrystalDatabaseClass to hoDB
152 Set pvComObject of hoDB to vDB
153 Set phoDatabaseClass to hoDB
154 End
155
156 Function_Return (phoDatabaseClass(Self))
157 End_Function
158
159 { Visibility=Private }
160 Procedure LoadDatabaseTablesClass Handle hoDatabaseTables
161 Integer iCount iTable
162 Variant vTable
163 Handle[] hoTables
164 Handle hoTable
165
166 Get ComCount of hoDatabaseTables to iCount
167
168 For iTable from 1 to iCount
169 Get ComItem of hoDatabaseTables iTable to vTable
170 Get Create U_cFlex2CrystalTableClass to hoTable
171 Set pvComObject of hoTable to vTable
172 Move hoTable to hoTables[iTable-1]
173 Loop
174
175 Set phoTablesClass to hoTables
176 End_Procedure
177
178 { Visibility=Private }
179 Function DatabaseTablesClassObject Returns Handle
180 Variant vTables
181 Handle hoDatabaseTables hoDatabase
182
183 If (not(phoDatabaseTablesClass(Self))) Begin
184 Get DatabaseClassObject to hoDatabase
185 Get ComTables of hoDatabase to vTables
186 Get Create of hoDatabase U_cFlex2CrystalTablesClass to hoDatabaseTables
187 Set pvComObject of hoDatabaseTables to vTables
188 Set phoDatabaseTablesClass to hoDatabaseTables
189
190 Send LoadDatabaseTablesClass hoDatabaseTables
191 End
192
193 Function_Return (phoDatabaseTablesClass(Self))
194 End_Function
195
196 { Visibility=Private }
197 Function TableClassObjects Returns Handle[]
198 Handle hoDatabaseTables
199 Handle[] hoTables
200
201 If not (phoDatabaseTablesClass(Self)) Begin
202 Get DatabaseTablesClassObject to hoDatabaseTables
203 End
204 Get phoTablesClass to hoTables
205 Function_Return hoTables
206 End_Function // TableObjects
207
208 { Visibility=Private }
209 Function GetTableClassObjectByName String sTable Returns Handle
210 String sHoldName
211 Integer iTableItem iTableCount
212 Handle[] hoTables
213
214 Get TableClassObjects to hoTables
215 Move (SizeOfArray(hoTables)) to iTableCount
216 For iTableItem from 0 to (iTableCount-1)
217 Get ComName of hoTables[iTableItem] to sHoldName
218 If (Lowercase(sHoldName) = Lowercase(sTable)) Begin
219 Function_Return hoTables[iTableItem]
220 End
221 Loop
222 Function_Return 0
223 End_Function // GetTableObjectByName
224
225 // These procedures/functions create COM objects directly by C_ syntax
226
227// Function ExportObject Returns Handle
228// Handle hoExport hcExportObject
229// Variant vExport
230// Boolean bAttached
231//
232// Get phoExportObject to hoExport
233// If (not(hoExport)) Begin
234// Delegate Get phcExportObject to hcExportObject
235// Get Create hcExportObject to hoExport
236// Send CreateComObject of hoExport
237// //Set Name of hoExport to "oExport" // for debugging purposes only
238// Get IsComObjectCreated of hoExport to bAttached
239// If (bAttached) Begin
240// Set phoExportObject to hoExport
241// End
242// Else Begin
243// Send Destroy of hoExport
244// Move 0 to hoExport
245// Set phoExportObject to 0
246// Error DFERR_CRYSTAL_REPORT C_$ErrorCreatingExportObject
247// End
248// End
249// Function_Return hoExport
250//
251// End_Function
252
253 { Visibility=Private }
254 Function DatabaseObject Returns Handle
255 Handle hoDatabase
256 Variant vDatabase
257
258 If (not(phoDatabase(Self))) Begin
259 Get Create U_cFlex2CrystalDatabase to hoDatabase
260 Get ComDatabase to vDatabase
261 Set pvComObject of hoDatabase to vDatabase
262 Set phoDatabase to hoDatabase
263 End
264
265 Function_Return (phoDatabase(Self))
266 End_Function
267
268 { Visibility=Private }
269 Procedure LoadDatabaseTables Handle hoDatabaseTables
270 Integer iCount iTable
271 Variant vTable
272 Handle[] hoTables
273 Handle hoTable
274
275 Get ComCount of hoDatabaseTables to iCount
276
277 For iTable from 1 to iCount
278 Get ComItem of hoDatabaseTables iTable to vTable
279 Get Create U_cFlex2CrystalDatabaseTable to hoTable
280 Set pvComObject of hoTable to vTable
281 Move hoTable to hoTables[iTable-1]
282 Loop
283
284 Set phoTables to hoTables
285 End_Procedure
286
287 { Visibility=Private }
288 Function DatabaseTablesObject Returns Handle
289 Variant vTables
290 Handle hoDatabaseTables hoDatabase
291
292 If (not(phoDatabaseTables(Self))) Begin
293 Get DatabaseObject to hoDatabase
294 Get ComTables of hoDatabase to vTables
295 Get Create of hoDatabase U_cFlex2CrystalDatabaseTables to hoDatabaseTables
296 Set pvComObject of hoDatabaseTables to vTables
297 Set phoDatabaseTables to hoDatabaseTables
298
299 Send LoadDatabaseTables hoDatabaseTables
300 End
301
302 Function_Return (phoDatabaseTables(Self))
303 End_Function
304
305 { Visibility=Private }
306 Function DataDefinitionObject Returns Handle
307 Variant vDataDefinition
308 Handle hoDataDefinition
309
310 If (not(phoDataDefinition(Self))) Begin
311 Get ComDataDefinition to vDataDefinition
312 Get Create U_cFlex2CrystalDataDefinition to hoDataDefinition
313 Set pvComObject of hoDataDefinition to vDataDefinition
314 Set phoDataDefinition to hoDataDefinition
315 End
316
317 Function_Return (phoDataDefinition(Self))
318 End_Function
319
320 { Visibility=Private }
321 Function FormulaFieldDefinitionsObject Returns Handle
322 Variant vFormulaFieldDefinitions
323 Handle hoFormulaFieldDefinitions hoDataDefinition
324
325 If (not(phoFormulaFieldDefinitions(Self))) Begin
326 Get DataDefinitionObject to hoDataDefinition
327 Get ComFormulaFields of hoDataDefinition to vFormulaFieldDefinitions
328 Get Create U_cFlex2CrystalFormulaFieldDefinitions to hoFormulaFieldDefinitions
329 Set pvComObject of hoFormulaFieldDefinitions to vFormulaFieldDefinitions
330 Set phoFormulaFieldDefinitions to hoFormulaFieldDefinitions
331 End
332
333 Function_Return (phoFormulaFieldDefinitions(Self))
334 End_Function
335
336 Procedure AssignFormula String sFormulaName String sValue
337 Variant vFormulaFieldDefinition
338 Handle hoFormulaFieldDefinitions hoFormulaDefinition
339 Boolean bShowError bAttached
340
341 Get FormulaFieldDefinitionsObject to hoFormulaFieldDefinitions
342 Get Create of hoFormulaFieldDefinitions U_cFlex2CrystalFormulaFieldDefinition to hoFormulaDefinition
343
344 Get Display_Error_State to bShowError
345 Set Display_Error_State to False
346 Get ComItem of hoFormulaFieldDefinitions sFormulaName to vFormulaFieldDefinition
347 Set Display_Error_State to bShowError
348
349 Set pvComObject of hoFormulaDefinition to vFormulaFieldDefinition
350 Get IsComObjectCreated of hoFormulaDefinition to bAttached
351
352 If (bAttached) Begin
353 Set ComText of hoFormulaDefinition to sValue
354 End
355 Else Begin
356 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnableToCreateFormulaFieldObject, sFormulaName))
357 End
358 End_Procedure
359
360 Procedure LoadParams Handle hoParamFieldDefinitions
361 Integer iCount iParam
362 Variant vParam
363 Handle[] hoParams
364 Handle hoParam
365
366 Get ComCount of hoParamFieldDefinitions to iCount
367
368 For iParam from 1 to iCount
369 Get ComItem of hoParamFieldDefinitions iParam to vParam
370 Get Create U_cFlex2CrystalParameterFieldDefinition to hoParam
371 Set pvComObject of hoParam to vParam
372 Move hoParam to hoParams[iParam-1]
373 Loop
374
375 Set phoParams to hoParams
376 End_Procedure
377
378 { Visibility=Private }
379 Function ParameterFieldDefinitionsObject Returns Handle
380 Variant vParameterFieldDefinitions
381 Handle hoParameterFieldDefinitions hoDataDefinition
382
383 If (not(phoParamFieldDefinitions(Self))) Begin
384 Get DataDefinitionObject to hoDataDefinition
385 Get ComParameterFields of hoDataDefinition to vParameterFieldDefinitions
386 Get Create U_cFlex2CrystalParameterFieldDefinitions to hoParameterFieldDefinitions
387 Set pvComObject of hoParameterFieldDefinitions to vParameterFieldDefinitions
388 Set phoParamFieldDefinitions to hoParameterFieldDefinitions
389
390 Send LoadParams hoParameterFieldDefinitions
391 End
392
393 Function_Return (phoParamFieldDefinitions(Self))
394 End_Function
395
396 { Visibility=Private }
397 Function SortFieldsObject Returns Handle
398 Variant vSortFields
399 Handle hoSortFields hoDataDefinition
400
401 If (not(phoSortFields(Self))) Begin
402 Get DataDefinitionObject to hoDataDefinition
403 Get ComSortFields of hoDataDefinition to vSortFields
404 Get Create U_cFlex2CrystalSortFields to hoSortFields
405 Set pvComObject of hoSortFields to vSortFields
406 Set phoSortFields to hoSortFields
407 End
408
409 Function_Return (phoSortFields(Self))
410 End_Function
411
412 Procedure DeleteSortOrder
413 Variant vRCD vDDC vDD vSorts vSC vSort vSortFields
414 Handle hoRCD hoDDC hoDD hoSorts hoSC hoSort
415 Integer i
416
417 Get ComDataDefController of (ReportClientDocumentObject(Self)) to vDDC
418 Get Create U_cFlex2CrystalDataDefController to hoDDC
419 Set pvComObject of hoDDC to vDDC
420
421 Get ComDataDefinition of hoDDC to vDD
422 Get Create U_cComF2CCrystalDecisions_ReportAppServer_DataDefModel_DataDefinition to hoDD
423 Set pvComObject of hoDD to vDD
424
425 Get ComSorts of hoDD to vSorts
426 Get Create U_cComF2CISCRSorts to hoSorts
427 Set pvComObject of hoSorts to vSorts
428
429 Get ComSortController of hoDDC to vSC
430 Get Create U_cFlex2CrystalSortController to hoSC
431 Set pvComObject of hoSC to vSC
432
433 Get Create U_cFlex2CrystalSortClass to hoSort
434 Send CreateComObject of hoSort
435
436 For i from 1 to (ComCount(hoSorts))
437 Get ComItem of hoSorts i to vSort
438 Send ComRemove of hoSC vSort
439 Loop
440
441 Send Destroy of hoSort
442 Send Destroy of hoSC
443 Send Destroy of hoSorts
444 Send Destroy of hoDD
445 Send Destroy of hoDDC
446 End_Procedure
447
448 Procedure DeleteNthSortField Integer iSortItem
449 Variant vRCD vDDC vDD vSorts vSC vSort
450 Handle hoRCD hoDDC hoDD hoSorts hoSC hoSort
451 Integer i
452
453
454 Get ComDataDefController of (ReportClientDocumentObject(Self)) to vDDC
455 Get Create U_cFlex2CrystalDataDefController to hoDDC
456 Set pvComObject of hoDDC to vDDC
457
458 Get ComDataDefinition of hoDDC to vDD
459 Get Create U_cComF2CCrystalDecisions_ReportAppServer_DataDefModel_DataDefinition to hoDD
460 Set pvComObject of hoDD to vDD
461
462 Get ComSorts of hoDD to vSorts
463 Get Create U_cComF2CISCRSorts to hoSorts
464 Set pvComObject of hoSorts to vSorts
465
466 Get ComSortController of hoDDC to vSC
467 Get Create U_cFlex2CrystalSortController to hoSC
468 Set pvComObject of hoSC to vSC
469
470 Get Create U_cFlex2CrystalSortClass to hoSort
471 Send CreateComObject of hoSort
472
473 Get ComItem of hoSorts iSortItem to vSort
474 If (not(IsNullComObject(vSort))) Send ComRemove of hoSC vSort
475
476 Send Destroy of hoSort
477 Send Destroy of hoSC
478 Send Destroy of hoSorts
479 Send Destroy of hoDD
480 Send Destroy of hoDDC
481 End_Procedure
482
483 Procedure AppendSortField String sTable String sField crSortDirection SortOrder
484 Variant vField vFields
485 Handle hoSortFields hoDatabaseTable hoTableFields hoTableField
486 Variant vRCD vDB vTables vTable
487 Handle hoRCD hoDB hoTables hoTable
488 Boolean bOK bAttached
489 String sName
490 Integer iField iFieldCount
491
492 Get SortFieldsObject to hoSortFields
493 If (hoSortFields) Begin
494 Get GetTableClassObjectByName sTable to hoTable
495
496 If (hoTable) Begin
497 Get Create U_cFlex2CrystalFieldsClass to hoTableFields
498 Get Create U_cFlex2CrystalDBFieldClass to hoTableField
499
500 Get ComDataFields of hoTable to vFields
501 Set pvComObject of hoTableFields to vFields
502
503 Move (uppercase(sField)) to sField
504 Get ComCount of hoTableFields to iFieldCount
505 Move False to bOk
506 Move 1 to iField
507 While (not(bOk) and (iField<=iFieldCount))
508 Get ComItem of hoTableFields iField to vField
509 Set pvComObject of hoTableField to vField
510
511 Get ComName of hoTableField to sName
512 If (uppercase(sName)=sField) Begin
513 Variant vDDC vDD vSorts vSC
514 Handle hoDDC hoDD hoSorts hoSC hoSort
515
516 Get ComDataDefController of (ReportClientDocumentObject(Self)) to vDDC
517 Get Create U_cFlex2CrystalDataDefController to hoDDC
518 Set pvComObject of hoDDC to vDDC
519
520 Get ComDataDefinition of hoDDC to vDD
521 Get Create U_cComF2CCrystalDecisions_ReportAppServer_DataDefModel_DataDefinition to hoDD
522 Set pvComObject of hoDD to vDD
523
524 Get ComSorts of hoDD to vSorts
525 Get Create U_cComF2CISCRSorts to hoSorts
526 Set pvComObject of hoSorts to vSorts
527
528 Get ComSortController of hoDDC to vSC
529 Get Create U_cFlex2CrystalSortController to hoSC
530 Set pvComObject of hoSC to vSC
531
532 Get Create U_cFlex2CrystalSortClass to hoSort
533 Send CreateComObject of hoSort
534
535 Set ComDirection of hoSort to SortOrder
536 Set ComSortField of hoSort to (pvComObject(hoTableField))
537
538 Get ComAdd of hoSC (ComCount(hoSorts)+1) (pvComObject(hoSort)) to windowindex
539
540 Send Destroy of hoSort
541 Send Destroy of hoSC
542 Send Destroy of hoSorts
543 Send Destroy of hoDD
544 Send Destroy of hoDDC
545
546 Move True to bOk
547 End
548 Increment iField
549 End
550 Send Destroy of hoTableField
551 Send Destroy of hoTableFields
552 End
553 // if can't find table or field or whatever
554 If not bOk Begin
555 Error DFERR_CRYSTAL_REPORT (SFormat(C_$CannotAddSortField, sTable, sField))
556 End
557 End
558 End_Procedure
559
560 Function GetSortFieldByName String name Returns Handle
561 Handle hoSortFields hoSortField hoFieldDef
562 Variant vSortField vFieldDef
563 Integer iCount i
564 String fieldName
565
566 Get SortFieldsObject to hoSortFields
567
568 Get Create U_cFlex2CrystalSortField to hoSortField
569 Get Create U_cFlex2CrystalFieldDefinition to hoFieldDef
570 Get ComCount of hoSortFields to iCount
571 For i from 1 to iCount
572 Get ComItem of hoSortFields i to vSortField
573 Set pvComObject of hoSortField to vSortField
574 Get ComField of hoSortField to vFieldDef
575 Set pvComObject of hoFieldDef to vFieldDef
576 Get ComFormulaName of hoFieldDef to fieldName
577 If (uppercase(fieldName) = Uppercase(name)) Begin
578 Send Destroy of hoFieldDef
579 Function_Return hoSortField
580 End
581 Loop
582
583 Send Destroy of hoFieldDef
584 Send Destroy of hoSortField
585 Function_Return 0
586
587 End_Function
588
589 Procedure LoadSubreports
590 Variant vSubreports vSubreport vReport
591 Handle hoReports hoSubreport hoReport
592 Handle[] hoSubreports
593 String sSubreportName
594 Integer iCount iReport
595
596 Get ComSubreports to vSubreports
597 Get Create U_cFlex2CrystalSubReports to hoReports
598 Set pvComObject of hoReports to vSubreports
599
600 Get ComCount of hoReports to iCount
601 For iReport from 1 to iCount
602 Get ComItem of hoReports iReport to vSubreport
603 Get Create U_cFlex2CrystalReport to hoReport
604 Set pvComObject of hoReport to vSubreport
605 Get ComName of hoReport to sSubreportName
606
607 Set psReportLocation of hoReport to (psReportLocation(Self))
608 Set psSubreportName of hoReport to sSubreportName
609 Set phoParentReport of hoReport to Self
610
611 Move hoReport to hoSubreports[iReport-1]
612 Loop
613
614 Set phoSubReports to hoSubreports
615 Set pbSubReportsLoaded to True
616 End_Procedure
617
618 Function ComRecordSelectionFormula Returns String
619 Function_Return (ComRecordSelectionFormula(DataDefinitionObject(Self)))
620 End_Function
621
622 Procedure Set ComRecordSelectionFormula String value
623 Set ComRecordSelectionFormula of (DataDefinitionObject(Self)) to value
624 End_Procedure
625
626 // CDO Functions
627 Function CreateCDO String sFileName Returns Handle
628 Handle hoRS hoFields
629 Variant vFields
630
631 tCRWCDO[] CRWCDOs
632 Integer iCDOCount iFieldType iChannel iFieldSize
633 Boolean bOK
634 String sLocation sLine sField sFieldType sFieldSize DirSep
635
636 // Create CDO object
637 Get Create U_cComRecordset to hoRS
638 Send CreateComObject of hoRS
639 Set ComActiveConnection of hoRS to (NullComObject())
640 Set ComCursorLocation of hoRS to OLEadUseClient
641 Set ComLockType of hoRS to OLEadLockBatchOptimistic
642 Set ComCursorType of hoRS to OLEadOpenStatic
643
644 Get IsComObjectCreated of hoRS to bOk
645 If (bOk) Begin
646 Get ComFields of hoRS to vFields
647 Get Create U_cComFields to hoFields
648 Set pvComObject of hoFields to vFields
649
650 Get pCDOs to CRWCDOs
651 Move (SizeOfArray(CRWCDOs)) to iCDOCount
652 //
653 Move (Sysconf(SYSCONF_DIR_SEPARATOR)) to DirSep
654 Indicate Err False
655 Move (lowercase(sFileName)) to sFileName
656
657 If (ghoApplication) Begin
658 Get psDataPath of (phoWorkspace(ghoApplication)) to sLocation
659 If (Right(sLocation, 1) <> DirSep) Begin
660 Append sLocation DirSep
661 End
662 Get psReportLocation to sLocation
663 If (Right(sLocation, 1) <> DirSep) Begin
664 Append sLocation DirSep
665 End
666 End
667 File_Exist (sLocation-sFileName) bOk
668
669 If (bOk) Begin
670 Get Seq_New_Channel to iChannel
671 If (iChannel = DF_SEQ_CHANNEL_NOT_AVAILABLE) Begin
672 Error DFERR_CRYSTAL_REPORT C_$NoIOChannelAvailableForCDO
673 Move False to bOk
674 End
675 Else Begin
676 Direct_Input channel iChannel ("BINARY:"-sLocation-sFileName)
677 Repeat
678 Readln sLine
679 If ( not(SeqEof) and Trim(sLine<>"")) Begin
680
681 Move "" to sField
682 Move "" to sFieldType
683 Move 0 to iFieldType
684 Move "" to sFieldSize
685
686 Move (Left(sLine, (Pos(Character(9), sLine)))) to sField
687 Move (Replace(sField, sLine, "")) to sLine
688 Move (Trim(sLine)) to sLine
689 If (Pos(Character(9), sLine)) Begin
690 Move (Left(sLine, (Pos(Character(9), sLine)))) to sFieldType
691 End
692 Else Move sLine to sFieldType
693 Move (Replace(sFieldType, sLine, "")) to sLine
694 Move (Trim(sLine)) to sLine
695 If (Pos(Character(9), sLine)) Begin
696 Move (Left(sLine, (Pos(Character(9), sLine)))) to sFieldSize
697 End
698 Else Move sLine to sFieldSize
699
700// Move (Left(sLine, (Pos(" ", sLine)))) to sField
701// Move (Replace(sField, sLine, "")) to sLine
702// Move (Trim(sLine)) to sLine
703// If (Pos(" ", sLine)) Begin
704// Move (Left(sLine, (Pos(" ", sLine)))) to sFieldType
705// End
706// Else Move sLine to sFieldType
707// Move (Replace(sFieldType, sLine, "")) to sLine
708// Move (Trim(sLine)) to sLine
709// If (Pos(" ", sLine)) Begin
710// Move (Left(sLine, (Pos(" ", sLine)))) to sFieldSize
711// End
712// Else Move sLine to sFieldSize
713
714 Move (Trim(lowercase(sFieldType))) to sFieldType
715 Move sFieldSize to iFieldSize
716
717 If (sFieldType = "blob") Move OLEadBinary to iFieldType
718 Else If (sFieldType = "boolean") Move OLEadBoolean to iFieldType
719 Else If (sFieldType = "byte") Move OLEadUnsignedTinyInt to iFieldType
720 Else If (sFieldType = "currency") Move OLEadCurrency to iFieldType
721 Else If (sFieldType = "date") Move OLEadDate to iFieldType
722 Else If (sFieldType = "datetime") Move OLEadDate to iFieldType
723 Else If (sFieldType = "long") Move OLEadInteger to iFieldType
724 Else If (sFieldType = "memo") Move OLEadBSTR to iFieldType
725 Else If (sFieldType = "number") Move OLEadNumeric to iFieldType
726 Else If (sFieldType = "short") Move OLEadSmallInt to iFieldType
727 Else If (sFieldType = "string") Move OLEadBSTR to iFieldType
728 Else Move False to bOK // we didn't find a legal datatype in the ttx file
729
730 If (bOk) Begin
731 Send ComAppend of hoFields (Trim(sField)) iFieldType iFieldSize OLEadFldIsNullable
732 End
733 Else Begin
734 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnknownFieldTypeForCDO, sFieldType, sField))
735 End
736 End
737 Until ((SeqEof) or not(bOk))
738 Close_Input channel iChannel
739 Send Seq_Release_Channel iChannel
740 End
741 End
742 Else Begin
743 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnableToLocateCDOFile, sFileName))
744 End
745
746 Send Destroy of hoFields
747 End
748 Else Begin
749 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnableToCreateCDOobject,sFileName))
750 End
751
752 If bOk Begin
753 Send ComOpen_2 of hoRS
754 Move (Left(sFileName, (Length(sFileName)-4))) to CRWCDOs[iCDOCount].sTable
755 Move hoRS to CRWCDOs[iCDOCount].hoCDO
756 Set pCDOs to CRWCDOs
757 End
758 Else Begin
759 Send Destroy of hoRS
760 Move 0 to hoRS
761 End
762
763 Function_Return hoRS
764 End_Function // CreateCDO
765
766 { Visibility=Private }
767 Procedure AssignCDODataSources tCRWCDO[] CRWCDOs
768 Handle hoRS hoTable hoTLI hoCI
769 Handle hoDataTable hoDataAdapter
770 Variant vTLI vCI
771 Integer iCDOItem iCDOCount iRowsCount
772 String sTable sServerName
773
774 Move (SizeOfArray(CRWCDOs)) to iCDOCount
775 For iCDOItem from 0 to (iCDOCount-1)
776 Move CRWCDOs[iCDOItem].hoCDO to hoRS
777 If (hoRS) Begin
778 Get GetTableObjectByName CRWCDOs[iCDOItem].sTable to hoTable
779 If (hoTable) Begin
780 Get Create U_cFlex2CrystalTableLogOnInfo to hoTLI
781 Get ComLogOnInfo of hoTable to vTLI
782 Set pvComObject of hoTLI to vTLI
783 Get Create U_cFlex2CrystalConnectionInfo to hoCI
784 Get ComConnectionInfo of hoTLI to vCI
785 Set pvComObject of hoCI to vCI
786
787 Get ComServerName of hoCI to sServerName
788 If (Lowercase(sServerName) contains ".ttx") Begin
789 Get Create U_cComF2CDataTable to hoDataTable
790 Send CreateComObject of hoDataTable
791 Set ComTableName of hoDataTable to CRWCDOs[iCDOItem].sTable
792
793 Get Create U_cComF2COleDbDataAdapter to hoDataAdapter
794 Send CreateComObject of hoDataAdapter
795
796 Get ComFill_6 of hoDataAdapter (pvComObject(hoDatatable)) (pvComObject(hoRS)) to iRowsCount
797 Send ComSetDataSource_2 of hoTable (pvComObject(hoDataTable))
798
799 Send Destroy of hoDataAdapter
800 Send Destroy of hoDataTable
801 End
802 Send Destroy of hoTLI
803 Send Destroy of hoCI
804 End
805 End
806 Loop
807 End_Procedure // AssignCDODataSources
808
809 Procedure AssignADODataSources
810 Handle hoTable hoDataTableCollection hoDataTable
811 Variant vDataTable vTableCollection
812 Handle hoDataSet
813 Integer iTable iTableNdx
814 String sTable sDLL sFileName sLocation DirSep
815 Boolean bOk
816 Handle[] hoTables
817
818 Move (Sysconf(SYSCONF_DIR_SEPARATOR)) to DirSep
819 Get TableObjects to hoTables
820
821 For iTable from 0 to (SizeOfArray(hoTables)-1)
822 Move hoTables[iTable] to hoTable
823 If (hoTable) Begin
824 Get ComDllName of hoTable to sDLL
825 If (sDLL = "crdb_adoplus.dll") Begin
826 Get Create U_cComF2CSystem_Data_DataSet to hoDataSet
827 Send CreateComObject of hoDataSet
828
829 Move (lowercase(ComName(hoTable) - ".xsd")) to sFileName
830
831 If (ghoApplication) Begin
832 Get psDataPath of (phoWorkspace(ghoApplication)) to sLocation
833 If (Right(sLocation, 1) <> DirSep) Begin
834 Append sLocation DirSep
835 End
836 Get psReportLocation to sLocation
837 If (Right(sLocation, 1) <> DirSep) Begin
838 Append sLocation DirSep
839 End
840 End
841 File_Exist (sLocation-sFileName) bOk
842
843 If (bOk) Begin
844 Send ComReadXmlSchema_2 of hoDataSet (sLocation-sFileName)
845 Get ComTables of hoDataSet to vTableCollection
846 Get Create u_cComF2CDataTableCollection to hoDataTableCollection
847 Set pvComObject of hoDataTableCollection to vTableCollection
848
849 Get ComIndexOf_2 of hoDataTableCollection (ComName(hoTable)) to iTableNdx
850 Get ComItem_2 of hoDataTableCollection (iTableNdx+1) to vDataTable
851
852 Get Create U_cComF2CDataTable to hoDataTable
853 Set pvComObject of hoDataTable to vDataTable
854
855 Send LoadRowData hoDataTable (ComName(hoTable))
856 Send ComSetDataSource of hoTable (pvComObject(hoDataSet))
857 End
858
859 Send Destroy of hoDataSet
860 End
861 End
862 Loop
863 End_Procedure // AssignCDODataSources
864
865 Procedure AppendCDOData Handle hoCDO Variant[][] vCDOData
866 Integer iCol iMaxCol iItem iCount iType
867 Handle hoFields hoField
868 Variant vFields vField
869 Variant[] vFieldNames
870
871 Get ComFields of hoCDO to vFields
872 Get Create U_cComFields to hoFields
873 Set pvComObject of hoFields to vFields
874
875 // Get number of columns
876 Get ComCount of hoFields to iMaxCol
877 // Get number of rows of data in array
878 Move (SizeOfArray(vCDOData)) to iCount
879 Get Create U_cComField to hoField
880 For iCol from 0 to (iMaxCol-1)
881 Get ComItem of hoFields iCol to vField
882 Set pvComObject of hoField to vField
883 Get ComType of hoField to iType
884 // For each column Loop through each row and set the proper datatypes according to the CDO
885 For iItem from 0 to (iCount-1)
886 If (iType=OLEadInteger) Move (Cast(vCDOData[iItem][iCol],Integer)) to vCDOData[iItem][iCol]
887 Else If (iType = OLEadBSTR) Move (Cast(vCDOData[iItem][iCol],String)) to vCDOData[iItem][iCol]
888 Else If (iType = OLEadBoolean) Move (Cast(vCDOData[iItem][iCol],Boolean)) to vCDOData[iItem][iCol]
889 Else If (iType = OLEadCurrency) Move (Cast(vCDOData[iItem][iCol],Currency)) to vCDOData[iItem][iCol]
890 Else If (iType = OLEadDate) Move (Cast(vCDOData[iItem][iCol],Date)) to vCDOData[iItem][iCol]
891 Else If (iType = OLEadNumeric) Move (Cast(vCDOData[iItem][iCol],Real)) to vCDOData[iItem][iCol]
892 Else If (iType = OLEadSmallInt) Move (Cast(vCDOData[iItem][iCol],Short)) to vCDOData[iItem][iCol]
893 Else If (iType = OLEadUnsignedTinyInt) Move (Cast(vCDOData[iItem][iCol],UChar)) to vCDOData[iItem][iCol]
894 Loop
895 Get ComName of hoField to vFieldNames[iCol]
896 Loop
897
898 For iItem from 0 to (SizeOfArray(vCDOData)-1)
899 Send ComAddNew of hoCDO vFieldNames vCDOData[iItem]
900 Loop
901
902 Send Destroy of hoFields
903 Send Destroy of hoField
904 End_Procedure // AppendCDOData
905
906End_Class
907
908Class cFlex2Crystal is a cCrystal
909
910 Procedure Construct_Object
911 Property Boolean pbForceCompatible False
912 Forward Send Construct_Object
913 Set phcReportObject to U_cFlex2CrystalReport
914 Set phcPreviewObject to U_cFlex2CrystalPreview
915 Set phcExportObject to U_cFlex2CrystalExportOptions
916 End_Procedure
917
918 // In cCrystal.pkg, this function creates the application object (which doesn't exist in new
919 // versions of Crystal). So we need to replace this function and have it create a fake
920 // application object.
921 Function ApplicationObject Returns Handle
922 Handle hoReport
923
924 // TODO: Add code to make sure our replacement library is installed!
925
926 If (not(ghoCrystalReportServer)) Begin
927 Get Create of (If(ghoApplication, ghoApplication, desktop)) U_cFlex2CrystalApplication to ghoCrystalReportServer
928 End
929
930 If (not(phoReportObject(Self))) Begin
931 Get Create (phcReportObject(Self)) to hoReport
932 Set phoReportObject to hoReport
933 Set phoReportObject of ghoCrystalReportServer to hoReport
934 End
935
936 Function_Return ghoCrystalReportServer
937
938 End_Function
939
940 Procedure CloseReport
941 Send Destroy of (phoReportObject(Self))
942 Set phoReportObject to 0
943 Set phoReportObject of ghoCrystalReportServer to 0
944 End_Procedure
945
946 Procedure LoadRowData Handle hoDataTable String sTable
947 End_Procedure
948
949End_Class