1 /************************************************************** 2 * 3 * Licensed to the Apache Software Foundation (ASF) under one 4 * or more contributor license agreements. See the NOTICE file 5 * distributed with this work for additional information 6 * regarding copyright ownership. The ASF licenses this file 7 * to you under the Apache License, Version 2.0 (the 8 * "License"); you may not use this file except in compliance 9 * with the License. You may obtain a copy of the License at 10 * 11 * http://www.apache.org/licenses/LICENSE-2.0 12 * 13 * Unless required by applicable law or agreed to in writing, 14 * software distributed under the License is distributed on an 15 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16 * KIND, either express or implied. See the License for the 17 * specific language governing permissions and limitations 18 * under the License. 19 * 20 *************************************************************/ 21 22 23 24 // MARKER(update_precomp.py): autogen include statement, do not remove 25 #include "precompiled_basic.hxx" 26 27 #include <stdlib.h> // getenv 28 #include <vcl/svapp.hxx> 29 #include <vcl/mapmod.hxx> 30 #include <vcl/wrkwin.hxx> 31 #include <vcl/timer.hxx> 32 #include <basic/sbxvar.hxx> 33 #ifndef _SBX_HXX 34 #include <basic/sbx.hxx> 35 #endif 36 #include <svl/zforlist.hxx> 37 #include <tools/fsys.hxx> 38 #include <tools/urlobj.hxx> 39 #include <osl/file.hxx> 40 41 #ifdef OS2 42 #define INCL_DOS 43 #define INCL_DOSPROCESS 44 #include <svpm.h> 45 #endif 46 47 #ifndef CLK_TCK 48 #define CLK_TCK CLOCKS_PER_SEC 49 #endif 50 51 #include <vcl/jobset.hxx> 52 #include <basic/sbobjmod.hxx> 53 54 #include "sbintern.hxx" 55 #include "runtime.hxx" 56 #include "stdobj.hxx" 57 #include "rtlproto.hxx" 58 #include "dllmgr.hxx" 59 #include <iosys.hxx> 60 #include "sbunoobj.hxx" 61 #include "propacc.hxx" 62 63 64 #include <comphelper/processfactory.hxx> 65 66 #include <com/sun/star/uno/Sequence.hxx> 67 #include <com/sun/star/lang/XMultiServiceFactory.hpp> 68 #include <com/sun/star/i18n/XCalendar.hpp> 69 70 using namespace comphelper; 71 using namespace com::sun::star::uno; 72 using namespace com::sun::star::i18n; 73 74 75 static Reference< XCalendar > getLocaleCalendar( void ) 76 { 77 static Reference< XCalendar > xCalendar; 78 if( !xCalendar.is() ) 79 { 80 Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory(); 81 if( xSMgr.is() ) 82 { 83 xCalendar = Reference< XCalendar >( xSMgr->createInstance 84 ( ::rtl::OUString::createFromAscii( "com.sun.star.i18n.LocaleCalendar" ) ), UNO_QUERY ); 85 } 86 } 87 88 static com::sun::star::lang::Locale aLastLocale; 89 static bool bNeedsInit = true; 90 91 com::sun::star::lang::Locale aLocale = Application::GetSettings().GetLocale(); 92 bool bNeedsReload = false; 93 if( bNeedsInit ) 94 { 95 bNeedsInit = false; 96 bNeedsReload = true; 97 } 98 else if( aLocale.Language != aLastLocale.Language || 99 aLocale.Country != aLastLocale.Country ) 100 { 101 bNeedsReload = true; 102 } 103 if( bNeedsReload ) 104 { 105 aLastLocale = aLocale; 106 xCalendar->loadDefaultCalendar( aLocale ); 107 } 108 return xCalendar; 109 } 110 111 RTLFUNC(CallByName) 112 { 113 (void)pBasic; 114 (void)bWrite; 115 116 const sal_Int16 vbGet = 2; 117 const sal_Int16 vbLet = 4; 118 const sal_Int16 vbMethod = 1; 119 const sal_Int16 vbSet = 8; 120 121 // At least 3 parameter needed plus function itself -> 4 122 sal_uInt16 nParCount = rPar.Count(); 123 if ( nParCount < 4 ) 124 { 125 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 126 return; 127 } 128 129 // 1. parameter is object 130 SbxBase* pObjVar = (SbxObject*)rPar.Get(1)->GetObject(); 131 SbxObject* pObj = NULL; 132 if( pObjVar ) 133 pObj = PTR_CAST(SbxObject,pObjVar); 134 if( !pObj && pObjVar && pObjVar->ISA(SbxVariable) ) 135 { 136 SbxBase* pObjVarObj = ((SbxVariable*)pObjVar)->GetObject(); 137 pObj = PTR_CAST(SbxObject,pObjVarObj); 138 } 139 if( !pObj ) 140 { 141 StarBASIC::Error( SbERR_BAD_PARAMETER ); 142 return; 143 } 144 145 // 2. parameter is ProcedureName 146 String aNameStr = rPar.Get(2)->GetString(); 147 148 // 3. parameter is CallType 149 sal_Int16 nCallType = rPar.Get(3)->GetInteger(); 150 151 //SbxObject* pFindObj = NULL; 152 SbxVariable* pFindVar = pObj->Find( aNameStr, SbxCLASS_DONTCARE ); 153 if( pFindVar == NULL ) 154 { 155 StarBASIC::Error( SbERR_PROC_UNDEFINED ); 156 return; 157 } 158 159 switch( nCallType ) 160 { 161 case vbGet: 162 { 163 SbxValues aVals; 164 aVals.eType = SbxVARIANT; 165 pFindVar->Get( aVals ); 166 167 SbxVariableRef refVar = rPar.Get(0); 168 refVar->Put( aVals ); 169 } 170 break; 171 case vbLet: 172 case vbSet: 173 { 174 if ( nParCount != 5 ) 175 { 176 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 177 return; 178 } 179 SbxVariableRef pValVar = rPar.Get(4); 180 if( nCallType == vbLet ) 181 { 182 SbxValues aVals; 183 aVals.eType = SbxVARIANT; 184 pValVar->Get( aVals ); 185 pFindVar->Put( aVals ); 186 } 187 else 188 { 189 SbxVariableRef rFindVar = pFindVar; 190 SbiInstance* pInst = pINST; 191 SbiRuntime* pRT = pInst ? pInst->pRun : NULL; 192 if( pRT != NULL ) 193 pRT->StepSET_Impl( pValVar, rFindVar, false ); 194 } 195 } 196 break; 197 case vbMethod: 198 { 199 SbMethod* pMeth = PTR_CAST(SbMethod,pFindVar); 200 if( pMeth == NULL ) 201 { 202 StarBASIC::Error( SbERR_PROC_UNDEFINED ); 203 return; 204 } 205 206 // Setup parameters 207 SbxArrayRef xArray; 208 sal_uInt16 nMethParamCount = nParCount - 4; 209 if( nMethParamCount > 0 ) 210 { 211 xArray = new SbxArray; 212 for( sal_uInt16 i = 0 ; i < nMethParamCount ; i++ ) 213 { 214 SbxVariable* pPar = rPar.Get( i + 4 ); 215 xArray->Put( pPar, i + 1 ); 216 } 217 } 218 219 // Call method 220 SbxVariableRef refVar = rPar.Get(0); 221 if( xArray.Is() ) 222 pMeth->SetParameters( xArray ); 223 pMeth->Call( refVar ); 224 pMeth->SetParameters( NULL ); 225 } 226 break; 227 default: 228 StarBASIC::Error( SbERR_PROC_UNDEFINED ); 229 } 230 } 231 232 RTLFUNC(CBool) // JSM 233 { 234 (void)pBasic; 235 (void)bWrite; 236 237 sal_Bool bVal = sal_False; 238 if ( rPar.Count() == 2 ) 239 { 240 SbxVariable *pSbxVariable = rPar.Get(1); 241 bVal = pSbxVariable->GetBool(); 242 } 243 else 244 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 245 246 rPar.Get(0)->PutBool(bVal); 247 } 248 249 RTLFUNC(CByte) // JSM 250 { 251 (void)pBasic; 252 (void)bWrite; 253 254 sal_uInt8 nByte = 0; 255 if ( rPar.Count() == 2 ) 256 { 257 SbxVariable *pSbxVariable = rPar.Get(1); 258 nByte = pSbxVariable->GetByte(); 259 } 260 else 261 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 262 263 rPar.Get(0)->PutByte(nByte); 264 } 265 266 RTLFUNC(CCur) // JSM 267 { 268 (void)pBasic; 269 (void)bWrite; 270 271 SbxINT64 nCur = 0; 272 if ( rPar.Count() == 2 ) 273 { 274 SbxVariable *pSbxVariable = rPar.Get(1); 275 nCur = pSbxVariable->GetCurrency(); 276 } 277 else 278 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 279 280 rPar.Get(0)->PutCurrency( nCur ); 281 } 282 283 RTLFUNC(CDec) // JSM 284 { 285 (void)pBasic; 286 (void)bWrite; 287 288 #ifdef WNT 289 SbxDecimal* pDec = NULL; 290 if ( rPar.Count() == 2 ) 291 { 292 SbxVariable *pSbxVariable = rPar.Get(1); 293 pDec = pSbxVariable->GetDecimal(); 294 } 295 else 296 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 297 298 rPar.Get(0)->PutDecimal( pDec ); 299 #else 300 rPar.Get(0)->PutEmpty(); 301 StarBASIC::Error(SbERR_NOT_IMPLEMENTED); 302 #endif 303 } 304 305 RTLFUNC(CDate) // JSM 306 { 307 (void)pBasic; 308 (void)bWrite; 309 310 double nVal = 0.0; 311 if ( rPar.Count() == 2 ) 312 { 313 SbxVariable *pSbxVariable = rPar.Get(1); 314 nVal = pSbxVariable->GetDate(); 315 } 316 else 317 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 318 319 rPar.Get(0)->PutDate(nVal); 320 } 321 322 RTLFUNC(CDbl) // JSM 323 { 324 (void)pBasic; 325 (void)bWrite; 326 327 double nVal = 0.0; 328 if ( rPar.Count() == 2 ) 329 { 330 SbxVariable *pSbxVariable = rPar.Get(1); 331 if( pSbxVariable->GetType() == SbxSTRING ) 332 { 333 // AB #41690 , String holen 334 String aScanStr = pSbxVariable->GetString(); 335 SbError Error = SbxValue::ScanNumIntnl( aScanStr, nVal ); 336 if( Error != SbxERR_OK ) 337 StarBASIC::Error( Error ); 338 } 339 else 340 { 341 nVal = pSbxVariable->GetDouble(); 342 } 343 } 344 else 345 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 346 347 rPar.Get(0)->PutDouble(nVal); 348 } 349 350 RTLFUNC(CInt) // JSM 351 { 352 (void)pBasic; 353 (void)bWrite; 354 355 sal_Int16 nVal = 0; 356 if ( rPar.Count() == 2 ) 357 { 358 SbxVariable *pSbxVariable = rPar.Get(1); 359 nVal = pSbxVariable->GetInteger(); 360 } 361 else 362 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 363 364 rPar.Get(0)->PutInteger(nVal); 365 } 366 367 RTLFUNC(CLng) // JSM 368 { 369 (void)pBasic; 370 (void)bWrite; 371 372 sal_Int32 nVal = 0; 373 if ( rPar.Count() == 2 ) 374 { 375 SbxVariable *pSbxVariable = rPar.Get(1); 376 nVal = pSbxVariable->GetLong(); 377 } 378 else 379 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 380 381 rPar.Get(0)->PutLong(nVal); 382 } 383 384 RTLFUNC(CSng) // JSM 385 { 386 (void)pBasic; 387 (void)bWrite; 388 389 float nVal = (float)0.0; 390 if ( rPar.Count() == 2 ) 391 { 392 SbxVariable *pSbxVariable = rPar.Get(1); 393 if( pSbxVariable->GetType() == SbxSTRING ) 394 { 395 // AB #41690 , String holen 396 double dVal = 0.0; 397 String aScanStr = pSbxVariable->GetString(); 398 SbError Error = SbxValue::ScanNumIntnl( aScanStr, dVal, /*bSingle=*/sal_True ); 399 if( SbxBase::GetError() == SbxERR_OK && Error != SbxERR_OK ) 400 StarBASIC::Error( Error ); 401 nVal = (float)dVal; 402 } 403 else 404 { 405 nVal = pSbxVariable->GetSingle(); 406 } 407 } 408 else 409 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 410 411 rPar.Get(0)->PutSingle(nVal); 412 } 413 414 RTLFUNC(CStr) // JSM 415 { 416 (void)pBasic; 417 (void)bWrite; 418 419 String aString; 420 if ( rPar.Count() == 2 ) 421 { 422 SbxVariable *pSbxVariable = rPar.Get(1); 423 aString = pSbxVariable->GetString(); 424 } 425 else 426 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 427 428 rPar.Get(0)->PutString(aString); 429 } 430 431 RTLFUNC(CVar) // JSM 432 { 433 (void)pBasic; 434 (void)bWrite; 435 436 SbxValues aVals( SbxVARIANT ); 437 if ( rPar.Count() == 2 ) 438 { 439 SbxVariable *pSbxVariable = rPar.Get(1); 440 pSbxVariable->Get( aVals ); 441 } 442 else 443 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 444 445 rPar.Get(0)->Put( aVals ); 446 } 447 448 RTLFUNC(CVErr) 449 { 450 (void)pBasic; 451 (void)bWrite; 452 453 sal_Int16 nErrCode = 0; 454 if ( rPar.Count() == 2 ) 455 { 456 SbxVariable *pSbxVariable = rPar.Get(1); 457 nErrCode = pSbxVariable->GetInteger(); 458 } 459 else 460 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 461 462 rPar.Get(0)->PutErr( nErrCode ); 463 } 464 465 RTLFUNC(Iif) // JSM 466 { 467 (void)pBasic; 468 (void)bWrite; 469 470 if ( rPar.Count() == 4 ) 471 { 472 if (rPar.Get(1)->GetBool()) 473 *rPar.Get(0) = *rPar.Get(2); 474 else 475 *rPar.Get(0) = *rPar.Get(3); 476 } 477 else 478 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 479 } 480 481 RTLFUNC(GetSystemType) 482 { 483 (void)pBasic; 484 (void)bWrite; 485 486 if ( rPar.Count() != 1 ) 487 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 488 else 489 // Removed for SRC595 490 rPar.Get(0)->PutInteger( -1 ); 491 } 492 493 RTLFUNC(GetGUIType) 494 { 495 (void)pBasic; 496 (void)bWrite; 497 498 if ( rPar.Count() != 1 ) 499 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 500 else 501 { 502 // 17.7.2000 Make simple solution for testtool / fat office 503 #if defined (WNT) 504 rPar.Get(0)->PutInteger( 1 ); 505 #elif defined OS2 506 rPar.Get(0)->PutInteger( 2 ); 507 #elif defined UNX 508 rPar.Get(0)->PutInteger( 4 ); 509 #else 510 rPar.Get(0)->PutInteger( -1 ); 511 #endif 512 } 513 } 514 515 RTLFUNC(Red) 516 { 517 (void)pBasic; 518 (void)bWrite; 519 520 if ( rPar.Count() != 2 ) 521 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 522 else 523 { 524 sal_uIntPtr nRGB = (sal_uIntPtr)rPar.Get(1)->GetLong(); 525 nRGB &= 0x00FF0000; 526 nRGB >>= 16; 527 rPar.Get(0)->PutInteger( (sal_Int16)nRGB ); 528 } 529 } 530 531 RTLFUNC(Green) 532 { 533 (void)pBasic; 534 (void)bWrite; 535 536 if ( rPar.Count() != 2 ) 537 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 538 else 539 { 540 sal_uIntPtr nRGB = (sal_uIntPtr)rPar.Get(1)->GetLong(); 541 nRGB &= 0x0000FF00; 542 nRGB >>= 8; 543 rPar.Get(0)->PutInteger( (sal_Int16)nRGB ); 544 } 545 } 546 547 RTLFUNC(Blue) 548 { 549 (void)pBasic; 550 (void)bWrite; 551 552 if ( rPar.Count() != 2 ) 553 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 554 else 555 { 556 sal_uIntPtr nRGB = (sal_uIntPtr)rPar.Get(1)->GetLong(); 557 nRGB &= 0x000000FF; 558 rPar.Get(0)->PutInteger( (sal_Int16)nRGB ); 559 } 560 } 561 562 563 RTLFUNC(Switch) 564 { 565 (void)pBasic; 566 (void)bWrite; 567 568 sal_uInt16 nCount = rPar.Count(); 569 if( !(nCount & 0x0001 )) 570 // Anzahl der Argumente muss ungerade sein 571 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 572 sal_uInt16 nCurExpr = 1; 573 while( nCurExpr < (nCount-1) ) 574 { 575 if( rPar.Get( nCurExpr )->GetBool()) 576 { 577 (*rPar.Get(0)) = *(rPar.Get(nCurExpr+1)); 578 return; 579 } 580 nCurExpr += 2; 581 } 582 rPar.Get(0)->PutNull(); 583 } 584 585 //i#64882# Common wait impl for existing Wait and new WaitUntil 586 // rtl functions 587 void Wait_Impl( bool bDurationBased, SbxArray& rPar ) 588 { 589 if( rPar.Count() != 2 ) 590 { 591 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 592 return; 593 } 594 long nWait = 0; 595 if ( bDurationBased ) 596 { 597 double dWait = rPar.Get(1)->GetDouble(); 598 double dNow = Now_Impl(); 599 double dSecs = (double)( ( dWait - dNow ) * (double)( 24.0*3600.0) ); 600 nWait = (long)( dSecs * 1000 ); // wait in thousands of sec 601 } 602 else 603 nWait = rPar.Get(1)->GetLong(); 604 if( nWait < 0 ) 605 { 606 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 607 return; 608 } 609 610 Timer aTimer; 611 aTimer.SetTimeout( nWait ); 612 aTimer.Start(); 613 while ( aTimer.IsActive() ) 614 Application::Yield(); 615 } 616 617 //i#64882# 618 RTLFUNC(Wait) 619 { 620 (void)pBasic; 621 (void)bWrite; 622 Wait_Impl( false, rPar ); 623 } 624 625 //i#64882# add new WaitUntil ( for application.wait ) 626 // share wait_impl with 'normal' oobasic wait 627 RTLFUNC(WaitUntil) 628 { 629 (void)pBasic; 630 (void)bWrite; 631 Wait_Impl( true, rPar ); 632 } 633 634 RTLFUNC(DoEvents) 635 { 636 (void)pBasic; 637 (void)bWrite; 638 (void)rPar; 639 // Dummy implementation as the following code leads 640 // to performance problems for unknown reasons 641 //Timer aTimer; 642 //aTimer.SetTimeout( 1 ); 643 //aTimer.Start(); 644 //while ( aTimer.IsActive() ) 645 // Application::Reschedule(); 646 Application::Reschedule( true ); 647 } 648 649 RTLFUNC(GetGUIVersion) 650 { 651 (void)pBasic; 652 (void)bWrite; 653 654 if ( rPar.Count() != 1 ) 655 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 656 else 657 { 658 // Removed for SRC595 659 rPar.Get(0)->PutLong( -1 ); 660 } 661 } 662 663 RTLFUNC(Choose) 664 { 665 (void)pBasic; 666 (void)bWrite; 667 668 if ( rPar.Count() < 2 ) 669 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 670 sal_Int16 nIndex = rPar.Get(1)->GetInteger(); 671 sal_uInt16 nCount = rPar.Count(); 672 nCount--; 673 if( nCount == 1 || nIndex > (nCount-1) || nIndex < 1 ) 674 { 675 rPar.Get(0)->PutNull(); 676 return; 677 } 678 (*rPar.Get(0)) = *(rPar.Get(nIndex+1)); 679 } 680 681 682 RTLFUNC(Trim) 683 { 684 (void)pBasic; 685 (void)bWrite; 686 687 if ( rPar.Count() < 2 ) 688 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 689 else 690 { 691 String aStr( rPar.Get(1)->GetString() ); 692 aStr.EraseLeadingChars(); 693 aStr.EraseTrailingChars(); 694 rPar.Get(0)->PutString( aStr ); 695 } 696 } 697 698 RTLFUNC(GetSolarVersion) 699 { 700 (void)pBasic; 701 (void)bWrite; 702 703 rPar.Get(0)->PutLong( (sal_Int32)SUPD ); 704 } 705 706 RTLFUNC(TwipsPerPixelX) 707 { 708 (void)pBasic; 709 (void)bWrite; 710 711 sal_Int32 nResult = 0; 712 Size aSize( 100,0 ); 713 MapMode aMap( MAP_TWIP ); 714 OutputDevice* pDevice = Application::GetDefaultDevice(); 715 if( pDevice ) 716 { 717 aSize = pDevice->PixelToLogic( aSize, aMap ); 718 nResult = aSize.Width() / 100; 719 } 720 rPar.Get(0)->PutLong( nResult ); 721 } 722 723 RTLFUNC(TwipsPerPixelY) 724 { 725 (void)pBasic; 726 (void)bWrite; 727 728 sal_Int32 nResult = 0; 729 Size aSize( 0,100 ); 730 MapMode aMap( MAP_TWIP ); 731 OutputDevice* pDevice = Application::GetDefaultDevice(); 732 if( pDevice ) 733 { 734 aSize = pDevice->PixelToLogic( aSize, aMap ); 735 nResult = aSize.Height() / 100; 736 } 737 rPar.Get(0)->PutLong( nResult ); 738 } 739 740 741 RTLFUNC(FreeLibrary) 742 { 743 (void)pBasic; 744 (void)bWrite; 745 746 if ( rPar.Count() != 2 ) 747 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 748 pINST->GetDllMgr()->FreeDll( rPar.Get(1)->GetString() ); 749 } 750 bool IsBaseIndexOne() 751 { 752 bool result = false; 753 if ( pINST && pINST->pRun ) 754 { 755 sal_uInt16 res = pINST->pRun->GetBase(); 756 if ( res ) 757 result = true; 758 } 759 return result; 760 } 761 762 RTLFUNC(Array) 763 { 764 (void)pBasic; 765 (void)bWrite; 766 767 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); 768 sal_uInt16 nArraySize = rPar.Count() - 1; 769 770 // Option Base zunaechst ignorieren (kennt leider nur der Compiler) 771 bool bIncIndex = (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() ); 772 if( nArraySize ) 773 { 774 if ( bIncIndex ) 775 pArray->AddDim( 1, nArraySize ); 776 else 777 pArray->AddDim( 0, nArraySize-1 ); 778 } 779 else 780 { 781 pArray->unoAddDim( 0, -1 ); 782 } 783 784 // Parameter ins Array uebernehmen 785 // ATTENTION: Using type sal_uInt16 for loop variable is 786 // mandatory to workaround a problem with the 787 // Solaris Intel compiler optimizer! See i104354 788 for( sal_uInt16 i = 0 ; i < nArraySize ; i++ ) 789 { 790 SbxVariable* pVar = rPar.Get(i+1); 791 SbxVariable* pNew = new SbxVariable( *pVar ); 792 pNew->SetFlag( SBX_WRITE ); 793 short index = static_cast< short >(i); 794 if ( bIncIndex ) 795 ++index; 796 pArray->Put( pNew, &index ); 797 } 798 799 // Array zurueckliefern 800 SbxVariableRef refVar = rPar.Get(0); 801 sal_uInt16 nFlags = refVar->GetFlags(); 802 refVar->ResetFlag( SBX_FIXED ); 803 refVar->PutObject( pArray ); 804 refVar->SetFlags( nFlags ); 805 refVar->SetParameters( NULL ); 806 } 807 808 809 // Featurewunsch #57868 810 // Die Funktion liefert ein Variant-Array, wenn keine Parameter angegeben 811 // werden, wird ein leeres Array erzeugt (entsprechend dim a(), entspricht 812 // einer Sequence der Laenge 0 in Uno). 813 // Wenn Parameter angegeben sind, wird fuer jeden eine Dimension erzeugt 814 // DimArray( 2, 2, 4 ) entspricht DIM a( 2, 2, 4 ) 815 // Das Array ist immer vom Typ Variant 816 RTLFUNC(DimArray) 817 { 818 (void)pBasic; 819 (void)bWrite; 820 821 SbxDimArray * pArray = new SbxDimArray( SbxVARIANT ); 822 sal_uInt16 nArrayDims = rPar.Count() - 1; 823 if( nArrayDims > 0 ) 824 { 825 for( sal_uInt16 i = 0; i < nArrayDims ; i++ ) 826 { 827 sal_Int32 ub = rPar.Get(i+1)->GetLong(); 828 if( ub < 0 ) 829 { 830 StarBASIC::Error( SbERR_OUT_OF_RANGE ); 831 ub = 0; 832 } 833 pArray->AddDim32( 0, ub ); 834 } 835 } 836 else 837 pArray->unoAddDim( 0, -1 ); 838 839 // Array zurueckliefern 840 SbxVariableRef refVar = rPar.Get(0); 841 sal_uInt16 nFlags = refVar->GetFlags(); 842 refVar->ResetFlag( SBX_FIXED ); 843 refVar->PutObject( pArray ); 844 refVar->SetFlags( nFlags ); 845 refVar->SetParameters( NULL ); 846 } 847 848 /* 849 * FindObject und FindPropertyObject ermoeglichen es, 850 * Objekte und Properties vom Typ Objekt zur Laufzeit 851 * ueber ihren Namen als String-Parameter anzusprechen. 852 * 853 * Bsp.: 854 * MyObj.Prop1.Bla = 5 855 * 856 * entspricht: 857 * dim ObjVar as Object 858 * dim ObjProp as Object 859 * ObjName$ = "MyObj" 860 * ObjVar = FindObject( ObjName$ ) 861 * PropName$ = "Prop1" 862 * ObjProp = FindPropertyObject( ObjVar, PropName$ ) 863 * ObjProp.Bla = 5 864 * 865 * Dabei koennen die Namen zur Laufzeit dynamisch 866 * erzeugt werden und, so dass z.B. ueber Controls 867 * "TextEdit1" bis "TextEdit5" in einem Dialog in 868 * einer Schleife iteriert werden kann. 869 */ 870 871 // Objekt ueber den Namen ansprechen 872 // 1. Parameter = Name des Objekts als String 873 RTLFUNC(FindObject) 874 { 875 (void)pBasic; 876 (void)bWrite; 877 878 // Wir brauchen einen Parameter 879 if ( rPar.Count() < 2 ) 880 { 881 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 882 return; 883 } 884 885 // 1. Parameter ist der Name 886 String aNameStr = rPar.Get(1)->GetString(); 887 888 // Basic-Suchfunktion benutzen 889 SbxBase* pFind = StarBASIC::FindSBXInCurrentScope( aNameStr ); 890 SbxObject* pFindObj = NULL; 891 if( pFind ) 892 pFindObj = PTR_CAST(SbxObject,pFind); 893 /* 894 if( !pFindObj ) 895 { 896 StarBASIC::Error( SbERR_VAR_UNDEFINED ); 897 return; 898 } 899 */ 900 901 // Objekt zurueckliefern 902 SbxVariableRef refVar = rPar.Get(0); 903 refVar->PutObject( pFindObj ); 904 } 905 906 // Objekt-Property in einem Objekt ansprechen 907 // 1. Parameter = Objekt 908 // 2. Parameter = Name der Property als String 909 RTLFUNC(FindPropertyObject) 910 { 911 (void)pBasic; 912 (void)bWrite; 913 914 // Wir brauchen 2 Parameter 915 if ( rPar.Count() < 3 ) 916 { 917 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 918 return; 919 } 920 921 // 1. Parameter holen, muss Objekt sein 922 SbxBase* pObjVar = (SbxObject*)rPar.Get(1)->GetObject(); 923 SbxObject* pObj = NULL; 924 if( pObjVar ) 925 pObj = PTR_CAST(SbxObject,pObjVar); 926 if( !pObj && pObjVar && pObjVar->ISA(SbxVariable) ) 927 { 928 SbxBase* pObjVarObj = ((SbxVariable*)pObjVar)->GetObject(); 929 pObj = PTR_CAST(SbxObject,pObjVarObj); 930 } 931 /* 932 if( !pObj ) 933 { 934 StarBASIC::Error( SbERR_VAR_UNDEFINED ); 935 return; 936 } 937 */ 938 939 // 2. Parameter ist der Name 940 String aNameStr = rPar.Get(2)->GetString(); 941 942 // Jetzt muss ein Objekt da sein, sonst Error 943 SbxObject* pFindObj = NULL; 944 if( pObj ) 945 { 946 // Im Objekt nach Objekt suchen 947 SbxVariable* pFindVar = pObj->Find( aNameStr, SbxCLASS_OBJECT ); 948 pFindObj = PTR_CAST(SbxObject,pFindVar); 949 } 950 else 951 StarBASIC::Error( SbERR_BAD_PARAMETER ); 952 953 // Objekt zurueckliefern 954 SbxVariableRef refVar = rPar.Get(0); 955 refVar->PutObject( pFindObj ); 956 } 957 958 959 960 sal_Bool lcl_WriteSbxVariable( const SbxVariable& rVar, SvStream* pStrm, 961 sal_Bool bBinary, short nBlockLen, sal_Bool bIsArray ) 962 { 963 sal_uIntPtr nFPos = pStrm->Tell(); 964 965 sal_Bool bIsVariant = !rVar.IsFixed(); 966 SbxDataType eType = rVar.GetType(); 967 968 switch( eType ) 969 { 970 case SbxBOOL: 971 case SbxCHAR: 972 case SbxBYTE: 973 if( bIsVariant ) 974 *pStrm << (sal_uInt16)SbxBYTE; // VarType Id 975 *pStrm << rVar.GetByte(); 976 break; 977 978 case SbxEMPTY: 979 case SbxNULL: 980 case SbxVOID: 981 case SbxINTEGER: 982 case SbxUSHORT: 983 case SbxINT: 984 case SbxUINT: 985 if( bIsVariant ) 986 *pStrm << (sal_uInt16)SbxINTEGER; // VarType Id 987 *pStrm << rVar.GetInteger(); 988 break; 989 990 case SbxLONG: 991 case SbxULONG: 992 case SbxLONG64: 993 case SbxULONG64: 994 if( bIsVariant ) 995 *pStrm << (sal_uInt16)SbxLONG; // VarType Id 996 *pStrm << rVar.GetLong(); 997 break; 998 999 case SbxSINGLE: 1000 if( bIsVariant ) 1001 *pStrm << (sal_uInt16)eType; // VarType Id 1002 *pStrm << rVar.GetSingle(); 1003 break; 1004 1005 case SbxDOUBLE: 1006 case SbxCURRENCY: 1007 case SbxDATE: 1008 if( bIsVariant ) 1009 *pStrm << (sal_uInt16)eType; // VarType Id 1010 *pStrm << rVar.GetDouble(); 1011 break; 1012 1013 case SbxSTRING: 1014 case SbxLPSTR: 1015 { 1016 const String& rStr = rVar.GetString(); 1017 if( !bBinary || bIsArray ) 1018 { 1019 if( bIsVariant ) 1020 *pStrm << (sal_uInt16)SbxSTRING; 1021 pStrm->WriteByteString( rStr, gsl_getSystemTextEncoding() ); 1022 //*pStrm << rStr; 1023 } 1024 else 1025 { 1026 // ohne Laengenangabe! ohne Endekennung! 1027 // What does that mean for Unicode?! Choosing conversion to ByteString... 1028 ByteString aByteStr( rStr, gsl_getSystemTextEncoding() ); 1029 *pStrm << (const char*)aByteStr.GetBuffer(); 1030 //*pStrm << (const char*)rStr.GetStr(); 1031 } 1032 } 1033 break; 1034 1035 default: 1036 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1037 return sal_False; 1038 } 1039 1040 if( nBlockLen ) 1041 pStrm->Seek( nFPos + nBlockLen ); 1042 return pStrm->GetErrorCode() ? sal_False : sal_True; 1043 } 1044 1045 sal_Bool lcl_ReadSbxVariable( SbxVariable& rVar, SvStream* pStrm, 1046 sal_Bool bBinary, short nBlockLen, sal_Bool bIsArray ) 1047 { 1048 (void)bBinary; 1049 (void)bIsArray; 1050 1051 double aDouble; 1052 1053 sal_uIntPtr nFPos = pStrm->Tell(); 1054 1055 sal_Bool bIsVariant = !rVar.IsFixed(); 1056 SbxDataType eVarType = rVar.GetType(); 1057 1058 SbxDataType eSrcType = eVarType; 1059 if( bIsVariant ) 1060 { 1061 sal_uInt16 nTemp; 1062 *pStrm >> nTemp; 1063 eSrcType = (SbxDataType)nTemp; 1064 } 1065 1066 switch( eSrcType ) 1067 { 1068 case SbxBOOL: 1069 case SbxCHAR: 1070 case SbxBYTE: 1071 { 1072 sal_uInt8 aByte; 1073 *pStrm >> aByte; 1074 1075 if( bBinary && SbiRuntime::isVBAEnabled() && aByte == 1 && pStrm->IsEof() ) 1076 aByte = 0; 1077 1078 rVar.PutByte( aByte ); 1079 } 1080 break; 1081 1082 case SbxEMPTY: 1083 case SbxNULL: 1084 case SbxVOID: 1085 case SbxINTEGER: 1086 case SbxUSHORT: 1087 case SbxINT: 1088 case SbxUINT: 1089 { 1090 sal_Int16 aInt; 1091 *pStrm >> aInt; 1092 rVar.PutInteger( aInt ); 1093 } 1094 break; 1095 1096 case SbxLONG: 1097 case SbxULONG: 1098 case SbxLONG64: 1099 case SbxULONG64: 1100 { 1101 sal_Int32 aInt; 1102 *pStrm >> aInt; 1103 rVar.PutLong( aInt ); 1104 } 1105 break; 1106 1107 case SbxSINGLE: 1108 { 1109 float nS; 1110 *pStrm >> nS; 1111 rVar.PutSingle( nS ); 1112 } 1113 break; 1114 1115 case SbxDOUBLE: 1116 case SbxCURRENCY: 1117 { 1118 *pStrm >> aDouble; 1119 rVar.PutDouble( aDouble ); 1120 } 1121 break; 1122 1123 case SbxDATE: 1124 { 1125 *pStrm >> aDouble; 1126 rVar.PutDate( aDouble ); 1127 } 1128 break; 1129 1130 case SbxSTRING: 1131 case SbxLPSTR: 1132 { 1133 String aStr; 1134 pStrm->ReadByteString( aStr, gsl_getSystemTextEncoding() ); 1135 rVar.PutString( aStr ); 1136 } 1137 break; 1138 1139 default: 1140 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1141 return sal_False; 1142 } 1143 1144 if( nBlockLen ) 1145 pStrm->Seek( nFPos + nBlockLen ); 1146 return pStrm->GetErrorCode() ? sal_False : sal_True; 1147 } 1148 1149 1150 // nCurDim = 1...n 1151 sal_Bool lcl_WriteReadSbxArray( SbxDimArray& rArr, SvStream* pStrm, 1152 sal_Bool bBinary, short nCurDim, short* pOtherDims, sal_Bool bWrite ) 1153 { 1154 DBG_ASSERT( nCurDim > 0,"Bad Dim"); 1155 short nLower, nUpper; 1156 if( !rArr.GetDim( nCurDim, nLower, nUpper ) ) 1157 return sal_False; 1158 for( short nCur = nLower; nCur <= nUpper; nCur++ ) 1159 { 1160 pOtherDims[ nCurDim-1 ] = nCur; 1161 if( nCurDim != 1 ) 1162 lcl_WriteReadSbxArray(rArr, pStrm, bBinary, nCurDim-1, pOtherDims, bWrite); 1163 else 1164 { 1165 SbxVariable* pVar = rArr.Get( (const short*)pOtherDims ); 1166 sal_Bool bRet; 1167 if( bWrite ) 1168 bRet = lcl_WriteSbxVariable(*pVar, pStrm, bBinary, 0, sal_True ); 1169 else 1170 bRet = lcl_ReadSbxVariable(*pVar, pStrm, bBinary, 0, sal_True ); 1171 if( !bRet ) 1172 return sal_False; 1173 } 1174 } 1175 return sal_True; 1176 } 1177 1178 void PutGet( SbxArray& rPar, sal_Bool bPut ) 1179 { 1180 // Wir brauchen 3 Parameter 1181 if ( rPar.Count() != 4 ) 1182 { 1183 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1184 return; 1185 } 1186 sal_Int16 nFileNo = rPar.Get(1)->GetInteger(); 1187 SbxVariable* pVar2 = rPar.Get(2); 1188 SbxDataType eType2 = pVar2->GetType(); 1189 sal_Bool bHasRecordNo = (sal_Bool)(eType2 != SbxEMPTY && eType2 != SbxERROR); 1190 long nRecordNo = pVar2->GetLong(); 1191 if ( nFileNo < 1 || ( bHasRecordNo && nRecordNo < 1 ) ) 1192 { 1193 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1194 return; 1195 } 1196 nRecordNo--; // wir moegen's ab 0! 1197 SbiIoSystem* pIO = pINST->GetIoSystem(); 1198 SbiStream* pSbStrm = pIO->GetStream( nFileNo ); 1199 // das File muss Random (feste Record-Laenge) oder Binary sein 1200 if ( !pSbStrm || !(pSbStrm->GetMode() & (SBSTRM_BINARY | SBSTRM_RANDOM)) ) 1201 { 1202 StarBASIC::Error( SbERR_BAD_CHANNEL ); 1203 return; 1204 } 1205 1206 SvStream* pStrm = pSbStrm->GetStrm(); 1207 sal_Bool bRandom = pSbStrm->IsRandom(); 1208 short nBlockLen = bRandom ? pSbStrm->GetBlockLen() : 0; 1209 1210 if( bPut ) 1211 { 1212 // Datei aufplustern, falls jemand uebers Dateiende hinaus geseekt hat 1213 pSbStrm->ExpandFile(); 1214 } 1215 1216 // auf die Startposition seeken 1217 if( bHasRecordNo ) 1218 { 1219 sal_uIntPtr nFilePos = bRandom ? (sal_uIntPtr)(nBlockLen*nRecordNo) : (sal_uIntPtr)nRecordNo; 1220 pStrm->Seek( nFilePos ); 1221 } 1222 1223 SbxDimArray* pArr = 0; 1224 SbxVariable* pVar = rPar.Get(3); 1225 if( pVar->GetType() & SbxARRAY ) 1226 { 1227 SbxBase* pParObj = pVar->GetObject(); 1228 pArr = PTR_CAST(SbxDimArray,pParObj); 1229 } 1230 1231 sal_Bool bRet; 1232 1233 if( pArr ) 1234 { 1235 sal_uIntPtr nFPos = pStrm->Tell(); 1236 short nDims = pArr->GetDims(); 1237 short* pDims = new short[ nDims ]; 1238 bRet = lcl_WriteReadSbxArray(*pArr,pStrm,!bRandom,nDims,pDims,bPut); 1239 delete [] pDims; 1240 if( nBlockLen ) 1241 pStrm->Seek( nFPos + nBlockLen ); 1242 } 1243 else 1244 { 1245 if( bPut ) 1246 bRet = lcl_WriteSbxVariable(*pVar, pStrm, !bRandom, nBlockLen, sal_False); 1247 else 1248 bRet = lcl_ReadSbxVariable(*pVar, pStrm, !bRandom, nBlockLen, sal_False); 1249 } 1250 if( !bRet || pStrm->GetErrorCode() ) 1251 StarBASIC::Error( SbERR_IO_ERROR ); 1252 } 1253 1254 RTLFUNC(Put) 1255 { 1256 (void)pBasic; 1257 (void)bWrite; 1258 1259 PutGet( rPar, sal_True ); 1260 } 1261 1262 RTLFUNC(Get) 1263 { 1264 (void)pBasic; 1265 (void)bWrite; 1266 1267 PutGet( rPar, sal_False ); 1268 } 1269 1270 RTLFUNC(Environ) 1271 { 1272 (void)pBasic; 1273 (void)bWrite; 1274 1275 if ( rPar.Count() != 2 ) 1276 { 1277 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1278 return; 1279 } 1280 String aResult; 1281 // sollte ANSI sein, aber unter Win16 in DLL nicht moeglich 1282 ByteString aByteStr( rPar.Get(1)->GetString(), gsl_getSystemTextEncoding() ); 1283 const char* pEnvStr = getenv( aByteStr.GetBuffer() ); 1284 if ( pEnvStr ) 1285 aResult = String::CreateFromAscii( pEnvStr ); 1286 rPar.Get(0)->PutString( aResult ); 1287 } 1288 1289 static double GetDialogZoomFactor( sal_Bool bX, long nValue ) 1290 { 1291 OutputDevice* pDevice = Application::GetDefaultDevice(); 1292 double nResult = 0; 1293 if( pDevice ) 1294 { 1295 Size aRefSize( nValue, nValue ); 1296 Fraction aFracX( 1, 26 ); 1297 Fraction aFracY( 1, 24 ); 1298 MapMode aMap( MAP_APPFONT, Point(), aFracX, aFracY ); 1299 Size aScaledSize = pDevice->LogicToPixel( aRefSize, aMap ); 1300 aRefSize = pDevice->LogicToPixel( aRefSize, MapMode(MAP_TWIP) ); 1301 1302 double nRef, nScaled; 1303 if( bX ) 1304 { 1305 nRef = aRefSize.Width(); 1306 nScaled = aScaledSize.Width(); 1307 } 1308 else 1309 { 1310 nRef = aRefSize.Height(); 1311 nScaled = aScaledSize.Height(); 1312 } 1313 nResult = nScaled / nRef; 1314 } 1315 return nResult; 1316 } 1317 1318 1319 RTLFUNC(GetDialogZoomFactorX) 1320 { 1321 (void)pBasic; 1322 (void)bWrite; 1323 1324 if ( rPar.Count() != 2 ) 1325 { 1326 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1327 return; 1328 } 1329 rPar.Get(0)->PutDouble( GetDialogZoomFactor( sal_True, rPar.Get(1)->GetLong() )); 1330 } 1331 1332 RTLFUNC(GetDialogZoomFactorY) 1333 { 1334 (void)pBasic; 1335 (void)bWrite; 1336 1337 if ( rPar.Count() != 2 ) 1338 { 1339 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1340 return; 1341 } 1342 rPar.Get(0)->PutDouble( GetDialogZoomFactor( sal_False, rPar.Get(1)->GetLong())); 1343 } 1344 1345 1346 RTLFUNC(EnableReschedule) 1347 { 1348 (void)pBasic; 1349 (void)bWrite; 1350 1351 rPar.Get(0)->PutEmpty(); 1352 if ( rPar.Count() != 2 ) 1353 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1354 if( pINST ) 1355 pINST->EnableReschedule( rPar.Get(1)->GetBool() ); 1356 } 1357 1358 RTLFUNC(GetSystemTicks) 1359 { 1360 (void)pBasic; 1361 (void)bWrite; 1362 1363 if ( rPar.Count() != 1 ) 1364 { 1365 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1366 return; 1367 } 1368 rPar.Get(0)->PutLong( Time::GetSystemTicks() ); 1369 } 1370 1371 RTLFUNC(GetPathSeparator) 1372 { 1373 (void)pBasic; 1374 (void)bWrite; 1375 1376 if ( rPar.Count() != 1 ) 1377 { 1378 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1379 return; 1380 } 1381 rPar.Get(0)->PutString( DirEntry::GetAccessDelimiter() ); 1382 } 1383 1384 RTLFUNC(ResolvePath) 1385 { 1386 (void)pBasic; 1387 (void)bWrite; 1388 1389 if ( rPar.Count() == 2 ) 1390 { 1391 String aStr = rPar.Get(1)->GetString(); 1392 DirEntry aEntry( aStr ); 1393 //if( aEntry.IsVirtual() ) 1394 //aStr = aEntry.GetRealPathFromVirtualURL(); 1395 rPar.Get(0)->PutString( aStr ); 1396 } 1397 else 1398 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1399 } 1400 1401 RTLFUNC(TypeLen) 1402 { 1403 (void)pBasic; 1404 (void)bWrite; 1405 1406 if ( rPar.Count() != 2 ) 1407 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1408 else 1409 { 1410 SbxDataType eType = rPar.Get(1)->GetType(); 1411 sal_Int16 nLen = 0; 1412 switch( eType ) 1413 { 1414 case SbxEMPTY: 1415 case SbxNULL: 1416 case SbxVECTOR: 1417 case SbxARRAY: 1418 case SbxBYREF: 1419 case SbxVOID: 1420 case SbxHRESULT: 1421 case SbxPOINTER: 1422 case SbxDIMARRAY: 1423 case SbxCARRAY: 1424 case SbxUSERDEF: 1425 nLen = 0; 1426 break; 1427 1428 case SbxINTEGER: 1429 case SbxERROR: 1430 case SbxUSHORT: 1431 case SbxINT: 1432 case SbxUINT: 1433 nLen = 2; 1434 break; 1435 1436 case SbxLONG: 1437 case SbxSINGLE: 1438 case SbxULONG: 1439 nLen = 4; 1440 break; 1441 1442 case SbxDOUBLE: 1443 case SbxCURRENCY: 1444 case SbxDATE: 1445 case SbxLONG64: 1446 case SbxULONG64: 1447 nLen = 8; 1448 break; 1449 1450 case SbxOBJECT: 1451 case SbxVARIANT: 1452 case SbxDATAOBJECT: 1453 nLen = 0; 1454 break; 1455 1456 case SbxCHAR: 1457 case SbxBYTE: 1458 case SbxBOOL: 1459 nLen = 1; 1460 break; 1461 1462 case SbxLPSTR: 1463 case SbxLPWSTR: 1464 case SbxCoreSTRING: 1465 case SbxSTRING: 1466 nLen = (sal_Int16)rPar.Get(1)->GetString().Len(); 1467 break; 1468 1469 default: 1470 nLen = 0; 1471 } 1472 rPar.Get(0)->PutInteger( nLen ); 1473 } 1474 } 1475 1476 1477 // Uno-Struct eines beliebigen Typs erzeugen 1478 // 1. Parameter == Klassename, weitere Parameter zur Initialisierung 1479 RTLFUNC(CreateUnoStruct) 1480 { 1481 (void)pBasic; 1482 (void)bWrite; 1483 1484 RTL_Impl_CreateUnoStruct( pBasic, rPar, bWrite ); 1485 } 1486 1487 // Uno-Service erzeugen 1488 // 1. Parameter == Service-Name 1489 RTLFUNC(CreateUnoService) 1490 { 1491 (void)pBasic; 1492 (void)bWrite; 1493 1494 RTL_Impl_CreateUnoService( pBasic, rPar, bWrite ); 1495 } 1496 1497 RTLFUNC(CreateUnoServiceWithArguments) 1498 { 1499 (void)pBasic; 1500 (void)bWrite; 1501 1502 RTL_Impl_CreateUnoServiceWithArguments( pBasic, rPar, bWrite ); 1503 } 1504 1505 1506 RTLFUNC(CreateUnoValue) 1507 { 1508 (void)pBasic; 1509 (void)bWrite; 1510 1511 RTL_Impl_CreateUnoValue( pBasic, rPar, bWrite ); 1512 } 1513 1514 1515 // ServiceManager liefern (keine Parameter) 1516 RTLFUNC(GetProcessServiceManager) 1517 { 1518 (void)pBasic; 1519 (void)bWrite; 1520 1521 RTL_Impl_GetProcessServiceManager( pBasic, rPar, bWrite ); 1522 } 1523 1524 // PropertySet erzeugen 1525 // 1. Parameter == Sequence<PropertyValue> 1526 RTLFUNC(CreatePropertySet) 1527 { 1528 (void)pBasic; 1529 (void)bWrite; 1530 1531 RTL_Impl_CreatePropertySet( pBasic, rPar, bWrite ); 1532 } 1533 1534 // Abfragen, ob ein Interface unterstuetzt wird 1535 // Mehrere Interface-Namen als Parameter 1536 RTLFUNC(HasUnoInterfaces) 1537 { 1538 (void)pBasic; 1539 (void)bWrite; 1540 1541 RTL_Impl_HasInterfaces( pBasic, rPar, bWrite ); 1542 } 1543 1544 // Abfragen, ob ein Basic-Objekt ein Uno-Struct repraesentiert 1545 RTLFUNC(IsUnoStruct) 1546 { 1547 (void)pBasic; 1548 (void)bWrite; 1549 1550 RTL_Impl_IsUnoStruct( pBasic, rPar, bWrite ); 1551 } 1552 1553 // Abfragen, ob zwei Uno-Objekte identisch sind 1554 RTLFUNC(EqualUnoObjects) 1555 { 1556 (void)pBasic; 1557 (void)bWrite; 1558 1559 RTL_Impl_EqualUnoObjects( pBasic, rPar, bWrite ); 1560 } 1561 1562 // Instanciate "com.sun.star.awt.UnoControlDialog" on basis 1563 // of a DialogLibrary entry: Convert from XML-ByteSequence 1564 // and attach events. Implemented in classes\eventatt.cxx 1565 void RTL_Impl_CreateUnoDialog( StarBASIC* pBasic, SbxArray& rPar, sal_Bool bWrite ); 1566 1567 RTLFUNC(CreateUnoDialog) 1568 { 1569 (void)pBasic; 1570 (void)bWrite; 1571 1572 RTL_Impl_CreateUnoDialog( pBasic, rPar, bWrite ); 1573 } 1574 1575 // Return the application standard lib as root scope 1576 RTLFUNC(GlobalScope) 1577 { 1578 (void)pBasic; 1579 (void)bWrite; 1580 1581 SbxObject* p = pBasic; 1582 while( p->GetParent() ) 1583 p = p->GetParent(); 1584 1585 SbxVariableRef refVar = rPar.Get(0); 1586 refVar->PutObject( p ); 1587 } 1588 1589 // Helper functions to convert Url from/to system paths 1590 RTLFUNC(ConvertToUrl) 1591 { 1592 (void)pBasic; 1593 (void)bWrite; 1594 1595 if ( rPar.Count() == 2 ) 1596 { 1597 String aStr = rPar.Get(1)->GetString(); 1598 INetURLObject aURLObj( aStr, INET_PROT_FILE ); 1599 ::rtl::OUString aFileURL = aURLObj.GetMainURL( INetURLObject::NO_DECODE ); 1600 if( aFileURL.isEmpty() ) 1601 ::osl::File::getFileURLFromSystemPath( aFileURL, aFileURL ); 1602 if( aFileURL.isEmpty() ) 1603 aFileURL = aStr; 1604 rPar.Get(0)->PutString( String(aFileURL) ); 1605 } 1606 else 1607 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1608 } 1609 1610 RTLFUNC(ConvertFromUrl) 1611 { 1612 (void)pBasic; 1613 (void)bWrite; 1614 1615 if ( rPar.Count() == 2 ) 1616 { 1617 String aStr = rPar.Get(1)->GetString(); 1618 ::rtl::OUString aSysPath; 1619 ::osl::File::getSystemPathFromFileURL( aStr, aSysPath ); 1620 if( aSysPath.isEmpty() ) 1621 aSysPath = aStr; 1622 rPar.Get(0)->PutString( String(aSysPath) ); 1623 } 1624 else 1625 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1626 } 1627 1628 1629 // Provide DefaultContext 1630 RTLFUNC(GetDefaultContext) 1631 { 1632 (void)pBasic; 1633 (void)bWrite; 1634 1635 RTL_Impl_GetDefaultContext( pBasic, rPar, bWrite ); 1636 } 1637 1638 #ifdef DBG_TRACE_BASIC 1639 RTLFUNC(TraceCommand) 1640 { 1641 RTL_Impl_TraceCommand( pBasic, rPar, bWrite ); 1642 } 1643 #endif 1644 1645 RTLFUNC(Join) 1646 { 1647 (void)pBasic; 1648 (void)bWrite; 1649 1650 sal_uInt16 nParCount = rPar.Count(); 1651 if ( nParCount != 3 && nParCount != 2 ) 1652 { 1653 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1654 return; 1655 } 1656 SbxBase* pParObj = rPar.Get(1)->GetObject(); 1657 SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj); 1658 if( pArr ) 1659 { 1660 if( pArr->GetDims() != 1 ) 1661 StarBASIC::Error( SbERR_WRONG_DIMS ); // Syntax Error?! 1662 1663 String aDelim; 1664 if( nParCount == 3 ) 1665 aDelim = rPar.Get(2)->GetString(); 1666 else 1667 aDelim = String::CreateFromAscii( " " ); 1668 1669 String aRetStr; 1670 short nLower, nUpper; 1671 pArr->GetDim( 1, nLower, nUpper ); 1672 for( short i = nLower ; i <= nUpper ; ++i ) 1673 { 1674 String aStr = pArr->Get( &i )->GetString(); 1675 aRetStr += aStr; 1676 if( i != nUpper ) 1677 aRetStr += aDelim; 1678 } 1679 rPar.Get(0)->PutString( aRetStr ); 1680 } 1681 else 1682 StarBASIC::Error( SbERR_MUST_HAVE_DIMS ); 1683 } 1684 1685 1686 RTLFUNC(Split) 1687 { 1688 (void)pBasic; 1689 (void)bWrite; 1690 1691 sal_uInt16 nParCount = rPar.Count(); 1692 if ( nParCount < 2 ) 1693 { 1694 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1695 return; 1696 } 1697 1698 String aExpression = rPar.Get(1)->GetString(); 1699 short nArraySize = 0; 1700 StringVector vRet; 1701 if( aExpression.Len() ) 1702 { 1703 String aDelim; 1704 if( nParCount >= 3 ) 1705 aDelim = rPar.Get(2)->GetString(); 1706 else 1707 aDelim = String::CreateFromAscii( " " ); 1708 1709 sal_Int32 nCount = -1; 1710 if( nParCount == 4 ) 1711 nCount = rPar.Get(3)->GetLong(); 1712 1713 xub_StrLen nDelimLen = aDelim.Len(); 1714 if( nDelimLen ) 1715 { 1716 xub_StrLen iSearch = STRING_NOTFOUND; 1717 xub_StrLen iStart = 0; 1718 do 1719 { 1720 bool bBreak = false; 1721 if( nCount >= 0 && nArraySize == nCount - 1 ) 1722 bBreak = true; 1723 1724 iSearch = aExpression.Search( aDelim, iStart ); 1725 String aSubStr; 1726 if( iSearch != STRING_NOTFOUND && !bBreak ) 1727 { 1728 aSubStr = aExpression.Copy( iStart, iSearch - iStart ); 1729 iStart = iSearch + nDelimLen; 1730 } 1731 else 1732 { 1733 aSubStr = aExpression.Copy( iStart ); 1734 } 1735 vRet.push_back( aSubStr ); 1736 nArraySize++; 1737 1738 if( bBreak ) 1739 break; 1740 } 1741 while( iSearch != STRING_NOTFOUND ); 1742 } 1743 else 1744 { 1745 vRet.push_back( aExpression ); 1746 nArraySize = 1; 1747 } 1748 } 1749 1750 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); 1751 pArray->unoAddDim( 0, nArraySize-1 ); 1752 1753 // Parameter ins Array uebernehmen 1754 for( short i = 0 ; i < nArraySize ; i++ ) 1755 { 1756 SbxVariableRef xVar = new SbxVariable( SbxVARIANT ); 1757 xVar->PutString( vRet[i] ); 1758 pArray->Put( (SbxVariable*)xVar, &i ); 1759 } 1760 1761 // Array zurueckliefern 1762 SbxVariableRef refVar = rPar.Get(0); 1763 sal_uInt16 nFlags = refVar->GetFlags(); 1764 refVar->ResetFlag( SBX_FIXED ); 1765 refVar->PutObject( pArray ); 1766 refVar->SetFlags( nFlags ); 1767 refVar->SetParameters( NULL ); 1768 } 1769 1770 // MonthName(month[, abbreviate]) 1771 RTLFUNC(MonthName) 1772 { 1773 (void)pBasic; 1774 (void)bWrite; 1775 1776 sal_uInt16 nParCount = rPar.Count(); 1777 if( nParCount != 2 && nParCount != 3 ) 1778 { 1779 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1780 return; 1781 } 1782 1783 Reference< XCalendar > xCalendar = getLocaleCalendar(); 1784 if( !xCalendar.is() ) 1785 { 1786 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 1787 return; 1788 } 1789 Sequence< CalendarItem > aMonthSeq = xCalendar->getMonths(); 1790 sal_Int32 nMonthCount = aMonthSeq.getLength(); 1791 1792 sal_Int16 nVal = rPar.Get(1)->GetInteger(); 1793 if( nVal < 1 || nVal > nMonthCount ) 1794 { 1795 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1796 return; 1797 } 1798 1799 sal_Bool bAbbreviate = false; 1800 if( nParCount == 3 ) 1801 bAbbreviate = rPar.Get(2)->GetBool(); 1802 1803 const CalendarItem* pCalendarItems = aMonthSeq.getConstArray(); 1804 const CalendarItem& rItem = pCalendarItems[nVal - 1]; 1805 1806 ::rtl::OUString aRetStr = ( bAbbreviate ? rItem.AbbrevName : rItem.FullName ); 1807 rPar.Get(0)->PutString( String(aRetStr) ); 1808 } 1809 1810 // WeekdayName(weekday, abbreviate, firstdayofweek) 1811 RTLFUNC(WeekdayName) 1812 { 1813 (void)pBasic; 1814 (void)bWrite; 1815 1816 sal_uInt16 nParCount = rPar.Count(); 1817 if( nParCount < 2 || nParCount > 4 ) 1818 { 1819 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1820 return; 1821 } 1822 1823 Reference< XCalendar > xCalendar = getLocaleCalendar(); 1824 if( !xCalendar.is() ) 1825 { 1826 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 1827 return; 1828 } 1829 1830 Sequence< CalendarItem > aDaySeq = xCalendar->getDays(); 1831 sal_Int16 nDayCount = (sal_Int16)aDaySeq.getLength(); 1832 sal_Int16 nDay = rPar.Get(1)->GetInteger(); 1833 sal_Int16 nFirstDay = 0; 1834 if( nParCount == 4 ) 1835 { 1836 nFirstDay = rPar.Get(3)->GetInteger(); 1837 if( nFirstDay < 0 || nFirstDay > 7 ) 1838 { 1839 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1840 return; 1841 } 1842 } 1843 if( nFirstDay == 0 ) 1844 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 1845 1846 nDay = 1 + (nDay + nDayCount + nFirstDay - 2) % nDayCount; 1847 if( nDay < 1 || nDay > nDayCount ) 1848 { 1849 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1850 return; 1851 } 1852 1853 sal_Bool bAbbreviate = false; 1854 if( nParCount >= 3 ) 1855 { 1856 SbxVariable* pPar2 = rPar.Get(2); 1857 if( !pPar2->IsErr() ) 1858 bAbbreviate = pPar2->GetBool(); 1859 } 1860 1861 const CalendarItem* pCalendarItems = aDaySeq.getConstArray(); 1862 const CalendarItem& rItem = pCalendarItems[nDay - 1]; 1863 1864 ::rtl::OUString aRetStr = ( bAbbreviate ? rItem.AbbrevName : rItem.FullName ); 1865 rPar.Get(0)->PutString( String(aRetStr) ); 1866 } 1867 1868 sal_Int16 implGetWeekDay( double aDate, bool bFirstDayParam = false, sal_Int16 nFirstDay = 0 ) 1869 { 1870 Date aRefDate( 1,1,1900 ); 1871 long nDays = (long) aDate; 1872 nDays -= 2; // normieren: 1.1.1900 => 0 1873 aRefDate += nDays; 1874 DayOfWeek aDay = aRefDate.GetDayOfWeek(); 1875 sal_Int16 nDay; 1876 if ( aDay != SUNDAY ) 1877 nDay = (sal_Int16)aDay + 2; 1878 else 1879 nDay = 1; // 1==Sonntag 1880 1881 // #117253 Optional 2. parameter "firstdayofweek" 1882 if( bFirstDayParam ) 1883 { 1884 if( nFirstDay < 0 || nFirstDay > 7 ) 1885 { 1886 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1887 return 0; 1888 } 1889 if( nFirstDay == 0 ) 1890 { 1891 Reference< XCalendar > xCalendar = getLocaleCalendar(); 1892 if( !xCalendar.is() ) 1893 { 1894 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 1895 return 0; 1896 } 1897 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 1898 } 1899 nDay = 1 + (nDay + 7 - nFirstDay) % 7; 1900 } 1901 return nDay; 1902 } 1903 1904 RTLFUNC(Weekday) 1905 { 1906 (void)pBasic; 1907 (void)bWrite; 1908 1909 sal_uInt16 nParCount = rPar.Count(); 1910 if ( nParCount < 2 ) 1911 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1912 else 1913 { 1914 double aDate = rPar.Get(1)->GetDate(); 1915 1916 bool bFirstDay = false; 1917 sal_Int16 nFirstDay = 0; 1918 if ( nParCount > 2 ) 1919 { 1920 nFirstDay = rPar.Get(2)->GetInteger(); 1921 bFirstDay = true; 1922 } 1923 sal_Int16 nDay = implGetWeekDay( aDate, bFirstDay, nFirstDay ); 1924 rPar.Get(0)->PutInteger( nDay ); 1925 } 1926 } 1927 1928 1929 enum Interval 1930 { 1931 INTERVAL_NONE, 1932 INTERVAL_YYYY, 1933 INTERVAL_Q, 1934 INTERVAL_M, 1935 INTERVAL_Y, 1936 INTERVAL_D, 1937 INTERVAL_W, 1938 INTERVAL_WW, 1939 INTERVAL_H, 1940 INTERVAL_N, 1941 INTERVAL_S 1942 }; 1943 1944 struct IntervalInfo 1945 { 1946 Interval meInterval; 1947 const char* mpStringCode; 1948 double mdValue; 1949 bool mbSimple; 1950 1951 IntervalInfo( Interval eInterval, const char* pStringCode, double dValue, bool bSimple ) 1952 : meInterval( eInterval ) 1953 , mpStringCode( pStringCode ) 1954 , mdValue( dValue ) 1955 , mbSimple( bSimple ) 1956 {} 1957 }; 1958 1959 static IntervalInfo pIntervalTable[] = 1960 { 1961 IntervalInfo( INTERVAL_YYYY, "yyyy", 0.0, false ), // Year 1962 IntervalInfo( INTERVAL_Q, "q", 0.0, false ), // Quarter 1963 IntervalInfo( INTERVAL_M, "m", 0.0, false ), // Month 1964 IntervalInfo( INTERVAL_Y, "y", 1.0, true ), // Day of year 1965 IntervalInfo( INTERVAL_D, "d", 1.0, true ), // Day 1966 IntervalInfo( INTERVAL_W, "w", 1.0, true ), // Weekday 1967 IntervalInfo( INTERVAL_WW, "ww", 7.0, true ), // Week 1968 IntervalInfo( INTERVAL_H, "h", (1.0 / 24.0), true ), // Hour 1969 IntervalInfo( INTERVAL_N, "n", (1.0 / 1440.0), true), // Minute 1970 IntervalInfo( INTERVAL_S, "s", (1.0 / 86400.0), true ), // Second 1971 IntervalInfo( INTERVAL_NONE, NULL, 0.0, false ) 1972 }; 1973 1974 IntervalInfo* getIntervalInfo( const String& rStringCode ) 1975 { 1976 IntervalInfo* pInfo = NULL; 1977 sal_Int16 i = 0; 1978 while( (pInfo = pIntervalTable + i)->mpStringCode != NULL ) 1979 { 1980 if( rStringCode.EqualsIgnoreCaseAscii( pInfo->mpStringCode ) ) 1981 break; 1982 i++; 1983 } 1984 return pInfo; 1985 } 1986 1987 // From methods.cxx 1988 sal_Bool implDateSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay, double& rdRet ); 1989 sal_Int16 implGetDateDay( double aDate ); 1990 sal_Int16 implGetDateMonth( double aDate ); 1991 sal_Int16 implGetDateYear( double aDate ); 1992 1993 sal_Int16 implGetHour( double dDate ); 1994 sal_Int16 implGetMinute( double dDate ); 1995 sal_Int16 implGetSecond( double dDate ); 1996 1997 1998 inline void implGetDayMonthYear( sal_Int16& rnYear, sal_Int16& rnMonth, sal_Int16& rnDay, double dDate ) 1999 { 2000 rnDay = implGetDateDay( dDate ); 2001 rnMonth = implGetDateMonth( dDate ); 2002 rnYear = implGetDateYear( dDate ); 2003 } 2004 2005 inline sal_Int16 limitToINT16( sal_Int32 n32 ) 2006 { 2007 if( n32 > 32767 ) 2008 n32 = 32767; 2009 else if( n32 < -32768 ) 2010 n32 = -32768; 2011 return (sal_Int16)n32; 2012 } 2013 2014 RTLFUNC(DateAdd) 2015 { 2016 (void)pBasic; 2017 (void)bWrite; 2018 2019 sal_uInt16 nParCount = rPar.Count(); 2020 if( nParCount != 4 ) 2021 { 2022 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2023 return; 2024 } 2025 2026 String aStringCode = rPar.Get(1)->GetString(); 2027 IntervalInfo* pInfo = getIntervalInfo( aStringCode ); 2028 if( !pInfo ) 2029 { 2030 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2031 return; 2032 } 2033 2034 sal_Int32 lNumber = rPar.Get(2)->GetLong(); 2035 double dDate = rPar.Get(3)->GetDate(); 2036 double dNewDate = 0; 2037 if( pInfo->mbSimple ) 2038 { 2039 double dAdd = pInfo->mdValue * lNumber; 2040 dNewDate = dDate + dAdd; 2041 } 2042 else 2043 { 2044 // Keep hours, minutes, seconds 2045 double dHoursMinutesSeconds = dDate - floor( dDate ); 2046 2047 sal_Bool bOk = sal_True; 2048 sal_Int16 nYear, nMonth, nDay; 2049 sal_Int16 nTargetYear16 = 0, nTargetMonth = 0; 2050 implGetDayMonthYear( nYear, nMonth, nDay, dDate ); 2051 switch( pInfo->meInterval ) 2052 { 2053 case INTERVAL_YYYY: 2054 { 2055 sal_Int32 nTargetYear = lNumber + nYear; 2056 nTargetYear16 = limitToINT16( nTargetYear ); 2057 nTargetMonth = nMonth; 2058 bOk = implDateSerial( nTargetYear16, nTargetMonth, nDay, dNewDate ); 2059 break; 2060 } 2061 case INTERVAL_Q: 2062 case INTERVAL_M: 2063 { 2064 bool bNeg = (lNumber < 0); 2065 if( bNeg ) 2066 lNumber = -lNumber; 2067 sal_Int32 nYearsAdd; 2068 sal_Int16 nMonthAdd; 2069 if( pInfo->meInterval == INTERVAL_Q ) 2070 { 2071 nYearsAdd = lNumber / 4; 2072 nMonthAdd = (sal_Int16)( 3 * (lNumber % 4) ); 2073 } 2074 else 2075 { 2076 nYearsAdd = lNumber / 12; 2077 nMonthAdd = (sal_Int16)( lNumber % 12 ); 2078 } 2079 2080 sal_Int32 nTargetYear; 2081 if( bNeg ) 2082 { 2083 nTargetMonth = nMonth - nMonthAdd; 2084 if( nTargetMonth <= 0 ) 2085 { 2086 nTargetMonth += 12; 2087 nYearsAdd++; 2088 } 2089 nTargetYear = (sal_Int32)nYear - nYearsAdd; 2090 } 2091 else 2092 { 2093 nTargetMonth = nMonth + nMonthAdd; 2094 if( nTargetMonth > 12 ) 2095 { 2096 nTargetMonth -= 12; 2097 nYearsAdd++; 2098 } 2099 nTargetYear = (sal_Int32)nYear + nYearsAdd; 2100 } 2101 nTargetYear16 = limitToINT16( nTargetYear ); 2102 bOk = implDateSerial( nTargetYear16, nTargetMonth, nDay, dNewDate ); 2103 break; 2104 } 2105 default: break; 2106 } 2107 2108 if( bOk ) 2109 { 2110 // Overflow? 2111 sal_Int16 nNewYear, nNewMonth, nNewDay; 2112 implGetDayMonthYear( nNewYear, nNewMonth, nNewDay, dNewDate ); 2113 if( nNewYear > 9999 || nNewYear < 100 ) 2114 { 2115 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2116 return; 2117 } 2118 sal_Int16 nCorrectionDay = nDay; 2119 while( nNewMonth > nTargetMonth ) 2120 { 2121 nCorrectionDay--; 2122 implDateSerial( nTargetYear16, nTargetMonth, nCorrectionDay, dNewDate ); 2123 implGetDayMonthYear( nNewYear, nNewMonth, nNewDay, dNewDate ); 2124 } 2125 dNewDate += dHoursMinutesSeconds; 2126 } 2127 } 2128 2129 rPar.Get(0)->PutDate( dNewDate ); 2130 } 2131 2132 inline double RoundImpl( double d ) 2133 { 2134 return ( d >= 0 ) ? floor( d + 0.5 ) : -floor( -d + 0.5 ); 2135 } 2136 2137 RTLFUNC(DateDiff) 2138 { 2139 (void)pBasic; 2140 (void)bWrite; 2141 2142 // DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]]) 2143 2144 sal_uInt16 nParCount = rPar.Count(); 2145 if( nParCount < 4 || nParCount > 6 ) 2146 { 2147 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2148 return; 2149 } 2150 2151 String aStringCode = rPar.Get(1)->GetString(); 2152 IntervalInfo* pInfo = getIntervalInfo( aStringCode ); 2153 if( !pInfo ) 2154 { 2155 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2156 return; 2157 } 2158 2159 double dDate1 = rPar.Get(2)->GetDate(); 2160 double dDate2 = rPar.Get(3)->GetDate(); 2161 2162 double dRet = 0.0; 2163 switch( pInfo->meInterval ) 2164 { 2165 case INTERVAL_YYYY: 2166 { 2167 sal_Int16 nYear1 = implGetDateYear( dDate1 ); 2168 sal_Int16 nYear2 = implGetDateYear( dDate2 ); 2169 dRet = nYear2 - nYear1; 2170 break; 2171 } 2172 case INTERVAL_Q: 2173 { 2174 sal_Int16 nYear1 = implGetDateYear( dDate1 ); 2175 sal_Int16 nYear2 = implGetDateYear( dDate2 ); 2176 sal_Int16 nQ1 = 1 + (implGetDateMonth( dDate1 ) - 1) / 3; 2177 sal_Int16 nQ2 = 1 + (implGetDateMonth( dDate2 ) - 1) / 3; 2178 sal_Int16 nQGes1 = 4 * nYear1 + nQ1; 2179 sal_Int16 nQGes2 = 4 * nYear2 + nQ2; 2180 dRet = nQGes2 - nQGes1; 2181 break; 2182 } 2183 case INTERVAL_M: 2184 { 2185 sal_Int16 nYear1 = implGetDateYear( dDate1 ); 2186 sal_Int16 nYear2 = implGetDateYear( dDate2 ); 2187 sal_Int16 nMonth1 = implGetDateMonth( dDate1 ); 2188 sal_Int16 nMonth2 = implGetDateMonth( dDate2 ); 2189 sal_Int16 nMonthGes1 = 12 * nYear1 + nMonth1; 2190 sal_Int16 nMonthGes2 = 12 * nYear2 + nMonth2; 2191 dRet = nMonthGes2 - nMonthGes1; 2192 break; 2193 } 2194 case INTERVAL_Y: 2195 case INTERVAL_D: 2196 { 2197 double dDays1 = floor( dDate1 ); 2198 double dDays2 = floor( dDate2 ); 2199 dRet = dDays2 - dDays1; 2200 break; 2201 } 2202 case INTERVAL_W: 2203 case INTERVAL_WW: 2204 { 2205 double dDays1 = floor( dDate1 ); 2206 double dDays2 = floor( dDate2 ); 2207 if( pInfo->meInterval == INTERVAL_WW ) 2208 { 2209 sal_Int16 nFirstDay = 1; // Default 2210 if( nParCount >= 5 ) 2211 { 2212 nFirstDay = rPar.Get(4)->GetInteger(); 2213 if( nFirstDay < 0 || nFirstDay > 7 ) 2214 { 2215 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2216 return; 2217 } 2218 if( nFirstDay == 0 ) 2219 { 2220 Reference< XCalendar > xCalendar = getLocaleCalendar(); 2221 if( !xCalendar.is() ) 2222 { 2223 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 2224 return; 2225 } 2226 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 2227 } 2228 } 2229 sal_Int16 nDay1 = implGetWeekDay( dDate1 ); 2230 sal_Int16 nDay1_Diff = nDay1 - nFirstDay; 2231 if( nDay1_Diff < 0 ) 2232 nDay1_Diff += 7; 2233 dDays1 -= nDay1_Diff; 2234 2235 sal_Int16 nDay2 = implGetWeekDay( dDate2 ); 2236 sal_Int16 nDay2_Diff = nDay2 - nFirstDay; 2237 if( nDay2_Diff < 0 ) 2238 nDay2_Diff += 7; 2239 dDays2 -= nDay2_Diff; 2240 } 2241 2242 double dDiff = dDays2 - dDays1; 2243 dRet = ( dDiff >= 0 ) ? floor( dDiff / 7.0 ) : -floor( -dDiff / 7.0 ); 2244 break; 2245 } 2246 case INTERVAL_H: 2247 { 2248 double dFactor = 24.0; 2249 dRet = RoundImpl( dFactor * (dDate2 - dDate1) ); 2250 break; 2251 } 2252 case INTERVAL_N: 2253 { 2254 double dFactor =1440.0; 2255 dRet = RoundImpl( dFactor * (dDate2 - dDate1) ); 2256 break; 2257 } 2258 case INTERVAL_S: 2259 { 2260 double dFactor = 86400.0; 2261 dRet = RoundImpl( dFactor * (dDate2 - dDate1) ); 2262 break; 2263 } 2264 case INTERVAL_NONE: 2265 break; 2266 } 2267 rPar.Get(0)->PutDouble( dRet ); 2268 } 2269 2270 double implGetDateOfFirstDayInFirstWeek 2271 ( sal_Int16 nYear, sal_Int16& nFirstDay, sal_Int16& nFirstWeek, bool* pbError = NULL ) 2272 { 2273 SbError nError = 0; 2274 if( nFirstDay < 0 || nFirstDay > 7 ) 2275 nError = SbERR_BAD_ARGUMENT; 2276 2277 if( nFirstWeek < 0 || nFirstWeek > 3 ) 2278 nError = SbERR_BAD_ARGUMENT; 2279 2280 Reference< XCalendar > xCalendar; 2281 if( nFirstDay == 0 || nFirstWeek == 0 ) 2282 { 2283 xCalendar = getLocaleCalendar(); 2284 if( !xCalendar.is() ) 2285 nError = SbERR_BAD_ARGUMENT; 2286 } 2287 2288 if( nError != 0 ) 2289 { 2290 StarBASIC::Error( nError ); 2291 if( pbError ) 2292 *pbError = true; 2293 return 0.0; 2294 } 2295 2296 if( nFirstDay == 0 ) 2297 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 2298 2299 sal_Int16 nFirstWeekMinDays = 0; // Not used for vbFirstJan1 = default 2300 if( nFirstWeek == 0 ) 2301 { 2302 nFirstWeekMinDays = xCalendar->getMinimumNumberOfDaysForFirstWeek(); 2303 if( nFirstWeekMinDays == 1 ) 2304 { 2305 nFirstWeekMinDays = 0; 2306 nFirstWeek = 1; 2307 } 2308 else if( nFirstWeekMinDays == 4 ) 2309 nFirstWeek = 2; 2310 else if( nFirstWeekMinDays == 7 ) 2311 nFirstWeek = 3; 2312 } 2313 else if( nFirstWeek == 2 ) 2314 nFirstWeekMinDays = 4; // vbFirstFourDays 2315 else if( nFirstWeek == 3 ) 2316 nFirstWeekMinDays = 7; // vbFirstFourDays 2317 2318 double dBaseDate; 2319 implDateSerial( nYear, 1, 1, dBaseDate ); 2320 double dRetDate = dBaseDate; 2321 2322 sal_Int16 nWeekDay0101 = implGetWeekDay( dBaseDate ); 2323 sal_Int16 nDayDiff = nWeekDay0101 - nFirstDay; 2324 if( nDayDiff < 0 ) 2325 nDayDiff += 7; 2326 2327 if( nFirstWeekMinDays ) 2328 { 2329 sal_Int16 nThisWeeksDaysInYearCount = 7 - nDayDiff; 2330 if( nThisWeeksDaysInYearCount < nFirstWeekMinDays ) 2331 nDayDiff -= 7; 2332 } 2333 dRetDate = dBaseDate - nDayDiff; 2334 return dRetDate; 2335 } 2336 2337 RTLFUNC(DatePart) 2338 { 2339 (void)pBasic; 2340 (void)bWrite; 2341 2342 // DatePart(interval, date[,firstdayofweek[, firstweekofyear]]) 2343 2344 sal_uInt16 nParCount = rPar.Count(); 2345 if( nParCount < 3 || nParCount > 5 ) 2346 { 2347 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2348 return; 2349 } 2350 2351 String aStringCode = rPar.Get(1)->GetString(); 2352 IntervalInfo* pInfo = getIntervalInfo( aStringCode ); 2353 if( !pInfo ) 2354 { 2355 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2356 return; 2357 } 2358 2359 double dDate = rPar.Get(2)->GetDate(); 2360 2361 sal_Int32 nRet = 0; 2362 switch( pInfo->meInterval ) 2363 { 2364 case INTERVAL_YYYY: 2365 { 2366 nRet = implGetDateYear( dDate ); 2367 break; 2368 } 2369 case INTERVAL_Q: 2370 { 2371 nRet = 1 + (implGetDateMonth( dDate ) - 1) / 3; 2372 break; 2373 } 2374 case INTERVAL_M: 2375 { 2376 nRet = implGetDateMonth( dDate ); 2377 break; 2378 } 2379 case INTERVAL_Y: 2380 { 2381 sal_Int16 nYear = implGetDateYear( dDate ); 2382 double dBaseDate; 2383 implDateSerial( nYear, 1, 1, dBaseDate ); 2384 nRet = 1 + sal_Int32( dDate - dBaseDate ); 2385 break; 2386 } 2387 case INTERVAL_D: 2388 { 2389 nRet = implGetDateDay( dDate ); 2390 break; 2391 } 2392 case INTERVAL_W: 2393 { 2394 bool bFirstDay = false; 2395 sal_Int16 nFirstDay = 1; // Default 2396 if( nParCount >= 4 ) 2397 { 2398 nFirstDay = rPar.Get(3)->GetInteger(); 2399 bFirstDay = true; 2400 } 2401 nRet = implGetWeekDay( dDate, bFirstDay, nFirstDay ); 2402 break; 2403 } 2404 case INTERVAL_WW: 2405 { 2406 sal_Int16 nFirstDay = 1; // Default 2407 if( nParCount >= 4 ) 2408 nFirstDay = rPar.Get(3)->GetInteger(); 2409 2410 sal_Int16 nFirstWeek = 1; // Default 2411 if( nParCount == 5 ) 2412 nFirstWeek = rPar.Get(4)->GetInteger(); 2413 2414 sal_Int16 nYear = implGetDateYear( dDate ); 2415 bool bError = false; 2416 double dYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear, nFirstDay, nFirstWeek, &bError ); 2417 if( !bError ) 2418 { 2419 if( dYearFirstDay > dDate ) 2420 { 2421 // Date belongs to last year's week 2422 dYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear - 1, nFirstDay, nFirstWeek ); 2423 } 2424 else if( nFirstWeek != 1 ) 2425 { 2426 // Check if date belongs to next year 2427 double dNextYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear + 1, nFirstDay, nFirstWeek ); 2428 if( dDate >= dNextYearFirstDay ) 2429 dYearFirstDay = dNextYearFirstDay; 2430 } 2431 2432 // Calculate week 2433 double dDiff = dDate - dYearFirstDay; 2434 nRet = 1 + sal_Int32( dDiff / 7 ); 2435 } 2436 break; 2437 } 2438 case INTERVAL_H: 2439 { 2440 nRet = implGetHour( dDate ); 2441 break; 2442 } 2443 case INTERVAL_N: 2444 { 2445 nRet = implGetMinute( dDate ); 2446 break; 2447 } 2448 case INTERVAL_S: 2449 { 2450 nRet = implGetSecond( dDate ); 2451 break; 2452 } 2453 case INTERVAL_NONE: 2454 break; 2455 } 2456 rPar.Get(0)->PutLong( nRet ); 2457 } 2458 2459 // FormatDateTime(Date[,NamedFormat]) 2460 RTLFUNC(FormatDateTime) 2461 { 2462 (void)pBasic; 2463 (void)bWrite; 2464 2465 sal_uInt16 nParCount = rPar.Count(); 2466 if( nParCount < 2 || nParCount > 3 ) 2467 { 2468 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2469 return; 2470 } 2471 2472 double dDate = rPar.Get(1)->GetDate(); 2473 sal_Int16 nNamedFormat = 0; 2474 if( nParCount > 2 ) 2475 { 2476 nNamedFormat = rPar.Get(2)->GetInteger(); 2477 if( nNamedFormat < 0 || nNamedFormat > 4 ) 2478 { 2479 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2480 return; 2481 } 2482 } 2483 2484 Reference< XCalendar > xCalendar = getLocaleCalendar(); 2485 if( !xCalendar.is() ) 2486 { 2487 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 2488 return; 2489 } 2490 2491 String aRetStr; 2492 SbxVariableRef pSbxVar = new SbxVariable( SbxSTRING ); 2493 switch( nNamedFormat ) 2494 { 2495 // GeneralDate: 2496 // Display a date and/or time. If there is a date part, 2497 // display it as a short date. If there is a time part, 2498 // display it as a long time. If present, both parts are displayed. 2499 2500 // 12/21/2004 11:24:50 AM 2501 // 21.12.2004 12:13:51 2502 case 0: 2503 pSbxVar->PutDate( dDate ); 2504 aRetStr = pSbxVar->GetString(); 2505 break; 2506 2507 // LongDate: Display a date using the long date format specified 2508 // in your computer's regional settings. 2509 // Tuesday, December 21, 2004 2510 // Dienstag, 21. December 2004 2511 case 1: 2512 { 2513 SvNumberFormatter* pFormatter = NULL; 2514 if( pINST ) 2515 pFormatter = pINST->GetNumberFormatter(); 2516 else 2517 { 2518 sal_uInt32 n; // Dummy 2519 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n ); 2520 } 2521 2522 LanguageType eLangType = GetpApp()->GetSettings().GetLanguage(); 2523 sal_uIntPtr nIndex = pFormatter->GetFormatIndex( NF_DATE_SYSTEM_LONG, eLangType ); 2524 Color* pCol; 2525 pFormatter->GetOutputString( dDate, nIndex, aRetStr, &pCol ); 2526 2527 if( !pINST ) 2528 delete pFormatter; 2529 2530 break; 2531 } 2532 2533 // ShortDate: Display a date using the short date format specified 2534 // in your computer's regional settings. 2535 // 12/21/2004 2536 // 21.12.2004 2537 case 2: 2538 pSbxVar->PutDate( floor(dDate) ); 2539 aRetStr = pSbxVar->GetString(); 2540 break; 2541 2542 // LongTime: Display a time using the time format specified 2543 // in your computer's regional settings. 2544 // 11:24:50 AM 2545 // 12:13:51 2546 case 3: 2547 // ShortTime: Display a time using the 24-hour format (hh:mm). 2548 // 11:24 2549 case 4: 2550 double n; 2551 double dTime = modf( dDate, &n ); 2552 pSbxVar->PutDate( dTime ); 2553 if( nNamedFormat == 3 ) 2554 aRetStr = pSbxVar->GetString(); 2555 else 2556 aRetStr = pSbxVar->GetString().Copy( 0, 5 ); 2557 break; 2558 } 2559 2560 rPar.Get(0)->PutString( aRetStr ); 2561 } 2562 2563 RTLFUNC(Round) 2564 { 2565 (void)pBasic; 2566 (void)bWrite; 2567 2568 sal_uInt16 nParCount = rPar.Count(); 2569 if( nParCount != 2 && nParCount != 3 ) 2570 { 2571 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2572 return; 2573 } 2574 2575 SbxVariable *pSbxVariable = rPar.Get(1); 2576 double dVal = pSbxVariable->GetDouble(); 2577 double dRes = 0.0; 2578 if( dVal != 0.0 ) 2579 { 2580 bool bNeg = false; 2581 if( dVal < 0.0 ) 2582 { 2583 bNeg = true; 2584 dVal = -dVal; 2585 } 2586 2587 sal_Int16 numdecimalplaces = 0; 2588 if( nParCount == 3 ) 2589 { 2590 numdecimalplaces = rPar.Get(2)->GetInteger(); 2591 if( numdecimalplaces < 0 || numdecimalplaces > 22 ) 2592 { 2593 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2594 return; 2595 } 2596 } 2597 2598 if( numdecimalplaces == 0 ) 2599 { 2600 dRes = floor( dVal + 0.5 ); 2601 } 2602 else 2603 { 2604 double dFactor = pow( 10.0, numdecimalplaces ); 2605 dVal *= dFactor; 2606 dRes = floor( dVal + 0.5 ); 2607 dRes /= dFactor; 2608 } 2609 2610 if( bNeg ) 2611 dRes = -dRes; 2612 } 2613 rPar.Get(0)->PutDouble( dRes ); 2614 } 2615 2616 RTLFUNC(StrReverse) 2617 { 2618 (void)pBasic; 2619 (void)bWrite; 2620 2621 if ( rPar.Count() != 2 ) 2622 { 2623 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2624 return; 2625 } 2626 2627 SbxVariable *pSbxVariable = rPar.Get(1); 2628 if( pSbxVariable->IsNull() ) 2629 { 2630 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2631 return; 2632 } 2633 2634 String aStr = pSbxVariable->GetString(); 2635 aStr.Reverse(); 2636 rPar.Get(0)->PutString( aStr ); 2637 } 2638 2639 RTLFUNC(CompatibilityMode) 2640 { 2641 (void)pBasic; 2642 (void)bWrite; 2643 2644 bool bEnabled = false; 2645 sal_uInt16 nCount = rPar.Count(); 2646 if ( nCount != 1 && nCount != 2 ) 2647 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2648 2649 SbiInstance* pInst = pINST; 2650 if( pInst ) 2651 { 2652 if ( nCount == 2 ) 2653 pInst->EnableCompatibility( rPar.Get(1)->GetBool() ); 2654 2655 bEnabled = pInst->IsCompatibility(); 2656 } 2657 rPar.Get(0)->PutBool( bEnabled ); 2658 } 2659 2660 RTLFUNC(Input) 2661 { 2662 (void)pBasic; 2663 (void)bWrite; 2664 2665 // 2 parameters needed 2666 if ( rPar.Count() < 3 ) 2667 { 2668 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2669 return; 2670 } 2671 2672 sal_uInt16 nByteCount = rPar.Get(1)->GetUShort(); 2673 sal_Int16 nFileNumber = rPar.Get(2)->GetInteger(); 2674 2675 SbiIoSystem* pIosys = pINST->GetIoSystem(); 2676 SbiStream* pSbStrm = pIosys->GetStream( nFileNumber ); 2677 if ( !pSbStrm || !(pSbStrm->GetMode() & (SBSTRM_BINARY | SBSTRM_INPUT)) ) 2678 { 2679 StarBASIC::Error( SbERR_BAD_CHANNEL ); 2680 return; 2681 } 2682 2683 ByteString aByteBuffer; 2684 SbError err = pSbStrm->Read( aByteBuffer, nByteCount, true ); 2685 if( !err ) 2686 err = pIosys->GetError(); 2687 2688 if( err ) 2689 { 2690 StarBASIC::Error( err ); 2691 return; 2692 } 2693 rPar.Get(0)->PutString( String( aByteBuffer, gsl_getSystemTextEncoding() ) ); 2694 } 2695 2696 // #115824 2697 RTLFUNC(Me) 2698 { 2699 (void)pBasic; 2700 (void)bWrite; 2701 2702 SbModule* pActiveModule = pINST->GetActiveModule(); 2703 SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pActiveModule); 2704 SbxVariableRef refVar = rPar.Get(0); 2705 if( pClassModuleObject == NULL ) 2706 { 2707 SbObjModule* pMod = PTR_CAST(SbObjModule,pActiveModule); 2708 if ( pMod ) 2709 refVar->PutObject( pMod ); 2710 else 2711 StarBASIC::Error( SbERR_INVALID_USAGE_OBJECT ); 2712 } 2713 else 2714 refVar->PutObject( pClassModuleObject ); 2715 } 2716 2717