Module CheckForCrystal.dg
1Register_Object oCrystalReportTest
2
3Use cCrystal.pkg
4Use cRegistry.pkg
5Use StatPnl.pkg
6
7#IFDEF GET_SHELLEXECUTE
8#ELSE
9External_Function ShellExecute "ShellExecuteA" Shell32.Dll ;
10 Handle hwnd ;
11 String sOperation ;
12 String sFile ;
13 String sParameters ;
14 String sDirectory ;
15 Integer nShowCmd ;
16 Returns VOID_TYPE
17#ENDIF
18
19Use Windows.pkg
20Use cRichEdit.pkg
21Use cCrystal.pkg
22Use cCJGrid.pkg
23
24Struct tDLLVersion
25 String sDLLName
26 String sVersion
27End_Struct
28
29Object oCheckForCrystal is a ModalPanel
30
31 // Messages for the Status_Panel object
32 Procedure SetStatusMsg String sMsg
33 Send Initialize_StatusPanel of Status_Panel "Crystal Reports" "" sMsg
34 End_Procedure
35
36 Procedure PopupStatusPanel
37 Send Start_StatusPanel of Status_Panel
38 End_Procedure
39
40 Procedure DeactivateStatusPanel
41 Send Stop_StatusPanel of Status_Panel
42 End_Procedure
43
44 // Property to hold if Crystal Reports RDC components are loaded
45 Property Boolean pbCrystalLoaded False
46
47 // Property to hold if Crystal Reports XI CDO can be loaded
48 Property Boolean pbCrystalCDOLoaded False
49
50 // Property to hold if Crystal Reports Connectivity Kit DLLs are present
51 Property Boolean pbCrystalCKPresent False
52
53 // Property to hold the version information of several parts of the Crystal connection
54 Property tDLLVersion[] pVersionInfo
55
56 Procedure AddVersionInfo String sDLLName
57 tDLLVersion[] VersionInfo
58 Integer iElements iElement iArrayElement
59 Integer iVersionMajor iVersionMinor iVersionRelease iVersionBuild
60 Handle hoVersionInfo
61 Boolean bIncluded
62
63 Get pVersionInfo To VersionInfo
64
65 Move (SizeOfArray (VersionInfo)) To iElements
66 Move iElements To iArrayElement
67 Decrement iElements
68 For iElement From 0 To iElements
69 If (VersionInfo[iElement].sDLLName = sDLLName) Begin
70 Move iElement To iArrayElement
71 End
72 Loop
73
74 Get Create U_cVersionInfo To hoVersionInfo
75 If (hoVersionInfo > 0) Begin
76 Send DoCreate Of hoVersionInfo sDLLName
77 Get pbIncluded Of hoVersionInfo To bIncluded
78 If (bIncluded) Begin
79 Get piVersionMajor Of hoVersionInfo To iVersionMajor
80 Get piVersionMinor Of hoVersionInfo To iVersionMinor
81 Get piVersionRelease Of hoVersionInfo To iVersionRelease
82 Get piVersionBuild Of hoVersionInfo To iVersionBuild
83 End
84 Move sDLLName To VersionInfo[iArrayElement].sDLLName
85 Move (SFormat ("%1.%2.%3.%4", iVersionMajor, iVersionMinor, iVersionRelease, iVersionBuild)) To VersionInfo[iArrayElement].sVersion
86 Send Destroy Of hoVersionInfo
87 End
88
89 Set pVersionInfo To VersionInfo
90 End_Procedure
91
92 // Check if Crystal Reports RDC components can be loaded
93 Function CheckForCrystal Handle hoCrystalReport Returns Boolean
94 Boolean bCrystalLoaded
95 Handle hoApplicationObject
96 String sError
97
98 Get pbCrystalLoaded to bCrystalLoaded
99 If (not (bCrystalLoaded)) Begin
100 Send SetStatusMsg "Loading Crystal RDC Components. Please wait..."
101 Send PopupStatusPanel
102 Get ApplicationObject of hoCrystalReport to hoApplicationObject
103 Send DeactivateStatusPanel
104 If (not (hoApplicationObject)) Begin
105 Move "Could not connect to the Crystal RDC Application Object." to sError
106 Error DFERR_CRYSTAL_REPORT sError
107 End
108 Else Begin
109 Move True to bCrystalLoaded
110 End
111 End
112
113 Set pbCrystalLoaded to bCrystalLoaded
114
115 Function_Return bCrystalLoaded
116 End_Function
117
118 // Check if Crystal Reports CDO component can be created
119 Function CheckForCDO Handle hoCRReport Returns Boolean
120 Boolean bCDOFunctional
121 Boolean bErrorState
122 String sError
123 Handle hoCDO
124
125 // Try to create CDO object
126 Get Create U_cCrystalCrystalComObject to hoCDO
127 Send CreateComObject of hoCDO
128 Get IsComObjectCreated of hoCDO to bCDOFunctional
129 If (not (bCDOFunctional)) Begin
130 Move "Error creating Crystal Reports CDO object." to sError
131 Move (sError * "Make sure Crystal Data Object is installed and properly registered on your machine.") to sError
132 Error DFERR_CRYSTAL_REPORT sError
133 End
134
135 Set pbCrystalCDOLoaded to bCDOFunctional
136 Send Destroy of hoCDO
137
138 Function_Return bCDOFunctional
139 End_Function
140
141 // Check if Crystal Reports Connectivity Kit files are in the expected location
142 Function CheckCKFiles Handle hoRegistry Returns Boolean
143 Boolean bCrystalCKFound bValueExists
144 Boolean bDriverDLLExists bCrdbDLLExists
145 String sCommonDir sDriverDLL sCrdbDLL
146 Handle hDriverLib hCrdbLib
147 Integer iVoid
148
149 Get ValueExists Of hoRegistry "CommonFiles" To bValueExists
150 If (bValueExists) Begin
151 Get ReadString of hoRegistry "CommonFiles" to sCommonDir
152
153 If (Right(sCommonDir, 1) <> "\") Begin
154 Move (sCommonDir - "\") to sCommonDir
155 End
156
157 Move (sCommonDir - "p2bdfapi.dll") to sDriverDLL
158 Move (sCommonDir - "crdb_p2bdfapi.dll") to sCrdbDLL
159
160 Move (LoadLibrary (sDriverDLL)) To hDriverLib
161 Move (LoadLibrary (sCRDbDLL)) To hCrdbLib
162
163 If (hCrdbLib <> 0) Begin
164 Move (FreeLibrary (hCrdbLib)) To iVoid
165 End
166
167 If (hDriverLib <> 0) Begin
168 Move (FreeLibrary (hDriverLib)) To iVoid
169 End
170
171 File_Exist sDriverDLL bDriverDLLExists
172 File_Exist sCrdbDLL bCrdbDLLExists
173
174 If (bDriverDLLExists) Begin
175 Send AddVersionInfo sDriverDLL
176 End
177
178 If (bCrdbDLLExists) Begin
179 Send AddVersionInfo sCrdbDLL
180 End
181
182 Move (bDriverDLLExists And bCrdbDLLExists And hDriverLib <> 0 And hCrDbLib <> 0) to bCrystalCKFound
183 End
184
185 Function_Return bCrystalCKFound
186 End_Function
187
188 // Check if Crystal Reports Connectivity Kit is present in the development environment
189 Function CheckForCrystalCK Returns Boolean
190 Boolean bOpen bCrystalCKFound
191 Handle hoRegistry
192 String sError
193
194 Move False to bCrystalCKFound
195
196 Get create U_cRegistry to hoRegistry
197 Set pfAccessRights of hoRegistry to KEY_READ
198
199 Set phRootKey of hoRegistry to HKEY_LOCAL_MACHINE
200 Get OpenKey of hoRegistry "SOFTWARE\Business Objects\Suite 11.0\Crystal Reports" to bOpen
201 If (bOpen) Begin
202 Get CheckCKFiles hoRegistry to bCrystalCKFound
203 Send CloseKey of hoRegistry
204 End
205
206 If (not (bCrystalCKFound)) Begin
207 Move "Crystal Reports Connectivity Kit could not be found in the Crystal Reports XI CommonFiles directory." to sError
208 Error DFERR_CRYSTAL_REPORT sError
209 End
210
211 Set pbCrystalCKPresent to bCrystalCKFound
212 Send Destroy of hoRegistry
213
214 Function_Return bCrystalCKFound
215 End_Function
216
217 // Check if all Crystal Reports pieces necessary for the report to run can be used
218 Function CheckCrystalEnvironment Returns Boolean
219 Boolean bCR bCDO bCK
220
221 Get pbCrystalLoaded to bCR
222 Get pbCrystalCDOLoaded to bCDO
223 Get pbCrystalCKPresent to bCK
224
225 If (not(bCR)) Begin
226 Get CheckForCrystal oCrystalReportTest to bCR
227 Send UpdateCRStatus of oCheckEnvironmentGroup bCR
228 End
229
230 If (not(bCDO)) Begin
231 Get CheckForCDO oCrystalReportTest to bCDO
232 Send UpdateCDOStatus of oCheckEnvironmentGroup bCDO
233 End
234
235 If (not(bCK)) Begin
236 Get CheckForCrystalCK to bCK
237 Send UpdateCKStatus of oCheckEnvironmentGroup bCK
238 End
239
240 Function_Return (bCR and bCDO and bCK)
241 End_Function
242
243 // Display the dialog with information on tests performed
244 Procedure DisplayDialog
245 Send Popup_Modal
246 End_Procedure
247
248 Set Label to "Crystal Reports Test Information"
249 Set Location to 8 67
250 Set Size to 344 290
251 Set piMinSize to 333 286
252 Set Border_Style to Border_Thick
253 Set piMaxSize to 500 500
254
255 Procedure Page_Object Boolean bPage
256 Forward Send Page_Object bPage
257
258 If (bPage) Begin
259 Set Icon To "Default.Ico"
260 End
261 End_Procedure
262
263 Object oCloseBtn is a Button
264 Set Label to "&Close"
265 Set Location to 328 233
266 Set peAnchors to anBottomRight
267
268 Procedure OnClick
269 Send Close_Panel
270 End_Procedure // OnClick
271
272 End_Object // oCloseBtn
273
274 Object oIntroduction is a cRichEdit
275 Set Size to 207 277
276 Set Location to 5 7
277 Set Color to clWhite
278 Set TextColor to clBlue
279 Set Read_Only_State to True
280 Set peAnchors to anTopLeftRight
281
282 Procedure Page Boolean bPageObject
283
284 Forward Send Page bPageObject
285
286 If (bPageObject) Begin
287 Send Delete_Data
288
289 Send AppendText "This sample uses reports built with Crystal Reports. In order to run such reports "
290 Send AppendText "you need to have "
291
292 Set pbBold to True
293 Send AppendText "Crystal Reports for DataFlex installed. "
294 Set pbBold to False
295
296 Send AppendText "Also, for the reports using Crystal Data Objects (CDO), "
297 Send AppendTextLn "CDO needs to be installed and properly registered on this machine."
298 Send AppendTextLn ""
299
300 Set pbBold to True
301 Send AppendText "Note that the reports in this sample will only work if all the above items are available and can be used on your machine. "
302 Send AppendTextLn "This dialog is being displayed because at least one of the tests for Crystal failed."
303 Set pbBold to False
304 Send AppendTextLn ""
305
306 Send AppendTextLn "The following links will help you correcting your environment: "
307 Send AppendTextLn ""
308 Send AppendTextLn "ERROR: Could not connect to the Crystal RDC Application Object http://www.dataaccess.com/kbasepublic/kbprint.asp?ArticleID=2169"
309 Send AppendTextLn ""
310 Send AppendTextLn "ERROR: 'Unable to instantiate COM Object.' when running a report http://www.dataaccess.com/kbasepublic/kbprint.asp?ArticleID=2183"
311 Send AppendTextLn ""
312 Send AppendTextLn "INFO: Running Reports from Crystal XI from Visual DataFlex Application http://www.dataaccess.com/kbasepublic/kbprint.asp?ArticleId=2161"
313 Send AppendTextLn ""
314 Send AppendTextLn "Data Access Worldwide Knowledge Base -- http://www.dataaccess.com/KBase"
315
316 Send AppendTextLn ""
317 Send AppendText "If you need to buy Crystal Reports for DataFlex or need more information on the product, visit "
318 Set pbBold to True
319 Send AppendTextLn "http://www.dataaccess.com/Crystal"
320 Set pbBold to False
321
322 Send Beginning_of_Data
323 End
324
325 End_Procedure // Page
326
327 Procedure OnLinkClicked Integer iPositionStart Integer iPositionEnd
328 Handle hInstance hWnd
329 String sLinkText
330
331 Get TextRange iPositionStart iPositionEnd to sLinkText
332
333 If (sLinkText <> "") Begin
334 Get Window_Handle to hWnd
335 Move (ShellExecute (hWnd, "open", (Trim (sLinkText)), '', '', 1)) to hInstance
336 End
337 End_Procedure // OnLinkClicked
338
339 End_Object // oIntroduction
340
341 Object oCheckEnvironmentGroup is a Group
342 Set Size to 106 276
343 Set Location to 219 7
344 Set Label to "Results of Tests Performed"
345 Set peAnchors to anAll
346
347 Object oCR is a Form
348 Set Size to 14 187
349 Set Location to 11 83
350 Set Color to clBtnFace
351 Set Enabled_State to FALSE
352 Set Form_Justification_Mode 0 to Form_DisplayCenter
353 Set peAnchors to anTopLeftRight
354
355 Procedure Activating
356 Set Value to "Crystal Reports RDC Components"
357 Set Entry_State to False
358 End_Procedure
359
360 End_Object // oCR
361
362 Object oCDO is a Form
363 Set Size to 14 187
364 Set Location to 27 83
365 Set Color to clBtnFace
366 Set Enabled_State to False
367 Set Form_Justification_Mode 0 to Form_DisplayCenter
368 Set peAnchors to anTopLeftRight
369
370 Procedure Activating
371 Set Value to "Crystal Reports CDO"
372 Set Entry_State to False
373 End_Procedure
374
375 End_Object // oCDO
376
377 Object oCK is a Form
378 Set Size to 14 187
379 Set Location to 43 83
380 Set Color to clBtnFace
381 Set Enabled_State to False
382 Set Form_Justification_Mode 0 to FORM_DISPLAYCENTER
383 Set peAnchors to anTopLeftRight
384
385 Procedure Activating
386 Set Value to "Crystal Reports Connectivity Kit"
387
388 Set Entry_State to False
389 End_Procedure
390
391 End_Object // oCK
392
393 Object oCRComponentStatus is a Textbox
394 Set Label to "Untested"
395 Set Auto_Size_State to False
396 Set TextColor to clMaroon
397 Set Location to 11 5
398 Set Size to 13 73
399 Set TypeFace to "MS Sans Serif"
400 End_Object // oCRComponentStatus
401
402 Object oCDOStatus is a Textbox
403 Set Label to "Untested"
404 Set Auto_Size_State to False
405 Set TextColor to clMaroon
406 Set Location to 26 5
407 Set Size to 13 73
408 Set TypeFace to "MS Sans Serif"
409 End_Object // oCDOStatus
410
411 Object oCKStatus is a Textbox
412 Set Label to "Untested"
413 Set Auto_Size_State to False
414 Set TextColor to clMaroon
415 Set Location to 41 5
416 Set Size to 13 73
417 Set TypeFace to "MS Sans Serif"
418 End_Object // oCKStatus
419
420 Object oVersionInfoGrid is a cCJGrid
421 Set Size to 39 263
422 Set Location to 63 7
423 Set pbFocusSubItems to False
424 Set peVerticalGridStyle to xtpGridNoLines
425 Set piCaptionForeColor to clBlue
426 Set pbReadOnly to True
427
428 Object oCKModuleColumn is a cCJGridColumn
429 Set piWidth to 307
430 Set psCaption to "Connectivity Kit Module Name"
431 End_Object
432
433 Object oVersionColumn is a cCJGridColumn
434 Set piWidth to 87
435 Set psCaption to "Version"
436 End_Object
437
438 Procedure Activating
439 Integer iRetval iElements iElement iItems iItem
440 tDLLVersion[] VersionInfo
441 tDataSourceRow[] DataSource
442
443 Forward Send OnCreateGridControl
444
445 Get pVersionInfo to VersionInfo
446 Move (SizeOfArray (VersionInfo)) to iElements
447 For iElement from 0 to (iElements - 1)
448 Move VersionInfo[iElement].sDLLName to DataSource[iElement].sValue[0]
449 Move VersionInfo[iElement].sVersion to DataSource[iElement].sValue[1]
450 Loop
451
452 Send InitializeData DataSource
453
454 End_Procedure
455
456 End_Object
457
458
459 // Reset status text to Untested
460 Procedure ResetStatus Handle hoStatusObject
461 Set TextColor of hoStatusObject to clMaroon
462 Set Value of hoStatusObject to "Untested"
463 End_Procedure
464
465 // Set the status text of the passed object according to result passed as parameter
466 Procedure UpdateStatus Handle hoStatusObject Boolean bOK
467 String sStatus
468
469 If (bOK) Begin
470 Set TextColor of hoStatusObject to clBlue
471 Move "Passed" to sStatus
472 End
473 Else Begin
474 Set TextColor of hoStatusObject to clRed
475 Move "Failed" to sStatus
476 End
477
478 Set Value of hoStatusObject to sStatus
479 End_Procedure
480
481
482 // Reset Crystal Reports status text to Untested
483 Procedure ResetCRStatus
484 Send ResetStatus oCRComponentStatus
485 End_Procedure
486
487 // Set the status text of Crystal Reports according to result passed as parameter
488 Procedure UpdateCRStatus Boolean bOK
489 Send UpdateStatus oCRComponentStatus bOK
490 End_Procedure
491
492
493 // Reset CDO status text to Untested
494 Procedure ResetCDOStatus
495 Send ResetStatus oCDOStatus
496 End_Procedure
497
498 // Set the status text of CDO according to result passed as parameter
499 Procedure UpdateCDOStatus Boolean bOK
500 Send UpdateStatus oCDOStatus bOK
501 End_Procedure
502
503
504 // Reset Conectivity Kit status text to Untested
505 Procedure ResetCKStatus
506 Send ResetStatus oCKStatus
507 End_Procedure
508
509 // Set the status text of Connectivity Kit according to result passed as parameter
510 Procedure UpdateCKStatus Boolean bOK
511 Send UpdateStatus oCKStatus bOK
512 End_Procedure
513
514
515 // Reset all status texts to Untested
516 Procedure ResetStatuses
517 Send ResetCRStatus
518 Send ResetCDOStatus
519 Send ResetCKStatus
520 End_Procedure
521
522 End_Object // oCheckEnvironmentGroup
523
524 Object oCrystalReportTest is a cCrystal
525 // This object is to be used when checking for Crystal from the buttons on this dialog
526 End_Object // oCrystalReportTest
527
528End_Object // oCheckForCrystal
529