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