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; 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 // #i129350: In VBA mode, Array() is always 0-based per VBA spec 772 // (Option Base is not a VBA feature) 773 bool bVBAEnabled = SbiRuntime::isVBAEnabled(); 774 bool bIncIndex = (IsBaseIndexOne() && !bVBAEnabled) ; 775 if( nArraySize ) 776 { 777 if ( bIncIndex ) 778 pArray->AddDim( 1, nArraySize ); 779 else 780 pArray->AddDim( 0, nArraySize-1 ); 781 } 782 else 783 { 784 pArray->unoAddDim( 0, -1 ); 785 } 786 787 // Parameter ins Array uebernehmen 788 // ATTENTION: Using type sal_uInt16 for loop variable is 789 // mandatory to workaround a problem with the 790 // Solaris Intel compiler optimizer! See i104354 791 for( sal_uInt16 i = 0 ; i < nArraySize ; i++ ) 792 { 793 SbxVariable* pVar = rPar.Get(i+1); 794 SbxVariable* pNew = new SbxVariable( *pVar ); 795 pNew->SetFlag( SBX_WRITE ); 796 short index = static_cast< short >(i); 797 if ( bIncIndex ) 798 ++index; 799 pArray->Put( pNew, &index ); 800 } 801 802 // Array zurueckliefern 803 SbxVariableRef refVar = rPar.Get(0); 804 sal_uInt16 nFlags = refVar->GetFlags(); 805 refVar->ResetFlag( SBX_FIXED ); 806 refVar->PutObject( pArray ); 807 refVar->SetFlags( nFlags ); 808 refVar->SetParameters( NULL ); 809 } 810 811 812 // Featurewunsch #57868 813 // Die Funktion liefert ein Variant-Array, wenn keine Parameter angegeben 814 // werden, wird ein leeres Array erzeugt (entsprechend dim a(), entspricht 815 // einer Sequence der Laenge 0 in Uno). 816 // Wenn Parameter angegeben sind, wird fuer jeden eine Dimension erzeugt 817 // DimArray( 2, 2, 4 ) entspricht DIM a( 2, 2, 4 ) 818 // Das Array ist immer vom Typ Variant 819 RTLFUNC(DimArray) 820 { 821 (void)pBasic; 822 (void)bWrite; 823 824 SbxDimArray * pArray = new SbxDimArray( SbxVARIANT ); 825 sal_uInt16 nArrayDims = rPar.Count() - 1; 826 if( nArrayDims > 0 ) 827 { 828 for( sal_uInt16 i = 0; i < nArrayDims ; i++ ) 829 { 830 sal_Int32 ub = rPar.Get(i+1)->GetLong(); 831 if( ub < 0 ) 832 { 833 StarBASIC::Error( SbERR_OUT_OF_RANGE ); 834 ub = 0; 835 } 836 pArray->AddDim32( 0, ub ); 837 } 838 } 839 else 840 pArray->unoAddDim( 0, -1 ); 841 842 // Array zurueckliefern 843 SbxVariableRef refVar = rPar.Get(0); 844 sal_uInt16 nFlags = refVar->GetFlags(); 845 refVar->ResetFlag( SBX_FIXED ); 846 refVar->PutObject( pArray ); 847 refVar->SetFlags( nFlags ); 848 refVar->SetParameters( NULL ); 849 } 850 851 /* 852 * FindObject und FindPropertyObject ermoeglichen es, 853 * Objekte und Properties vom Typ Objekt zur Laufzeit 854 * ueber ihren Namen als String-Parameter anzusprechen. 855 * 856 * Bsp.: 857 * MyObj.Prop1.Bla = 5 858 * 859 * entspricht: 860 * dim ObjVar as Object 861 * dim ObjProp as Object 862 * ObjName$ = "MyObj" 863 * ObjVar = FindObject( ObjName$ ) 864 * PropName$ = "Prop1" 865 * ObjProp = FindPropertyObject( ObjVar, PropName$ ) 866 * ObjProp.Bla = 5 867 * 868 * Dabei koennen die Namen zur Laufzeit dynamisch 869 * erzeugt werden und, so dass z.B. ueber Controls 870 * "TextEdit1" bis "TextEdit5" in einem Dialog in 871 * einer Schleife iteriert werden kann. 872 */ 873 874 // Objekt ueber den Namen ansprechen 875 // 1. Parameter = Name des Objekts als String 876 RTLFUNC(FindObject) 877 { 878 (void)pBasic; 879 (void)bWrite; 880 881 // Wir brauchen einen Parameter 882 if ( rPar.Count() < 2 ) 883 { 884 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 885 return; 886 } 887 888 // 1. Parameter ist der Name 889 String aNameStr = rPar.Get(1)->GetString(); 890 891 // Basic-Suchfunktion benutzen 892 SbxBase* pFind = StarBASIC::FindSBXInCurrentScope( aNameStr ); 893 SbxObject* pFindObj = NULL; 894 if( pFind ) 895 pFindObj = PTR_CAST(SbxObject,pFind); 896 /* 897 if( !pFindObj ) 898 { 899 StarBASIC::Error( SbERR_VAR_UNDEFINED ); 900 return; 901 } 902 */ 903 904 // Objekt zurueckliefern 905 SbxVariableRef refVar = rPar.Get(0); 906 refVar->PutObject( pFindObj ); 907 } 908 909 // Objekt-Property in einem Objekt ansprechen 910 // 1. Parameter = Objekt 911 // 2. Parameter = Name der Property als String 912 RTLFUNC(FindPropertyObject) 913 { 914 (void)pBasic; 915 (void)bWrite; 916 917 // Wir brauchen 2 Parameter 918 if ( rPar.Count() < 3 ) 919 { 920 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 921 return; 922 } 923 924 // 1. Parameter holen, muss Objekt sein 925 SbxBase* pObjVar = (SbxObject*)rPar.Get(1)->GetObject(); 926 SbxObject* pObj = NULL; 927 if( pObjVar ) 928 pObj = PTR_CAST(SbxObject,pObjVar); 929 if( !pObj && pObjVar && pObjVar->ISA(SbxVariable) ) 930 { 931 SbxBase* pObjVarObj = ((SbxVariable*)pObjVar)->GetObject(); 932 pObj = PTR_CAST(SbxObject,pObjVarObj); 933 } 934 /* 935 if( !pObj ) 936 { 937 StarBASIC::Error( SbERR_VAR_UNDEFINED ); 938 return; 939 } 940 */ 941 942 // 2. Parameter ist der Name 943 String aNameStr = rPar.Get(2)->GetString(); 944 945 // Jetzt muss ein Objekt da sein, sonst Error 946 SbxObject* pFindObj = NULL; 947 if( pObj ) 948 { 949 // Im Objekt nach Objekt suchen 950 SbxVariable* pFindVar = pObj->Find( aNameStr, SbxCLASS_OBJECT ); 951 pFindObj = PTR_CAST(SbxObject,pFindVar); 952 } 953 else 954 StarBASIC::Error( SbERR_BAD_PARAMETER ); 955 956 // Objekt zurueckliefern 957 SbxVariableRef refVar = rPar.Get(0); 958 refVar->PutObject( pFindObj ); 959 } 960 961 962 963 sal_Bool lcl_WriteSbxVariable( const SbxVariable& rVar, SvStream* pStrm, 964 sal_Bool bBinary, short nBlockLen, sal_Bool bIsArray ) 965 { 966 sal_uIntPtr nFPos = pStrm->Tell(); 967 968 sal_Bool bIsVariant = !rVar.IsFixed(); 969 SbxDataType eType = rVar.GetType(); 970 971 switch( eType ) 972 { 973 case SbxBOOL: 974 case SbxCHAR: 975 case SbxBYTE: 976 if( bIsVariant ) 977 *pStrm << (sal_uInt16)SbxBYTE; // VarType Id 978 *pStrm << rVar.GetByte(); 979 break; 980 981 case SbxEMPTY: 982 case SbxNULL: 983 case SbxVOID: 984 case SbxINTEGER: 985 case SbxUSHORT: 986 case SbxINT: 987 case SbxUINT: 988 if( bIsVariant ) 989 *pStrm << (sal_uInt16)SbxINTEGER; // VarType Id 990 *pStrm << rVar.GetInteger(); 991 break; 992 993 case SbxLONG: 994 case SbxULONG: 995 case SbxLONG64: 996 case SbxULONG64: 997 if( bIsVariant ) 998 *pStrm << (sal_uInt16)SbxLONG; // VarType Id 999 *pStrm << rVar.GetLong(); 1000 break; 1001 1002 case SbxSINGLE: 1003 if( bIsVariant ) 1004 *pStrm << (sal_uInt16)eType; // VarType Id 1005 *pStrm << rVar.GetSingle(); 1006 break; 1007 1008 case SbxDOUBLE: 1009 case SbxCURRENCY: 1010 case SbxDATE: 1011 if( bIsVariant ) 1012 *pStrm << (sal_uInt16)eType; // VarType Id 1013 *pStrm << rVar.GetDouble(); 1014 break; 1015 1016 case SbxSTRING: 1017 case SbxLPSTR: 1018 { 1019 const String& rStr = rVar.GetString(); 1020 if( !bBinary || bIsArray ) 1021 { 1022 if( bIsVariant ) 1023 *pStrm << (sal_uInt16)SbxSTRING; 1024 pStrm->WriteByteString( rStr, gsl_getSystemTextEncoding() ); 1025 //*pStrm << rStr; 1026 } 1027 else 1028 { 1029 // ohne Laengenangabe! ohne Endekennung! 1030 // What does that mean for Unicode?! Choosing conversion to ByteString... 1031 ByteString aByteStr( rStr, gsl_getSystemTextEncoding() ); 1032 *pStrm << (const char*)aByteStr.GetBuffer(); 1033 //*pStrm << (const char*)rStr.GetStr(); 1034 } 1035 } 1036 break; 1037 1038 default: 1039 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1040 return sal_False; 1041 } 1042 1043 if( nBlockLen ) 1044 pStrm->Seek( nFPos + nBlockLen ); 1045 return pStrm->GetErrorCode() ? sal_False : sal_True; 1046 } 1047 1048 sal_Bool lcl_ReadSbxVariable( SbxVariable& rVar, SvStream* pStrm, 1049 sal_Bool bBinary, short nBlockLen, sal_Bool bIsArray ) 1050 { 1051 (void)bBinary; 1052 (void)bIsArray; 1053 1054 double aDouble; 1055 1056 sal_uIntPtr nFPos = pStrm->Tell(); 1057 1058 sal_Bool bIsVariant = !rVar.IsFixed(); 1059 SbxDataType eVarType = rVar.GetType(); 1060 1061 SbxDataType eSrcType = eVarType; 1062 if( bIsVariant ) 1063 { 1064 sal_uInt16 nTemp; 1065 *pStrm >> nTemp; 1066 eSrcType = (SbxDataType)nTemp; 1067 } 1068 1069 switch( eSrcType ) 1070 { 1071 case SbxBOOL: 1072 case SbxCHAR: 1073 case SbxBYTE: 1074 { 1075 sal_uInt8 aByte; 1076 *pStrm >> aByte; 1077 1078 if( bBinary && SbiRuntime::isVBAEnabled() && aByte == 1 && pStrm->IsEof() ) 1079 aByte = 0; 1080 1081 rVar.PutByte( aByte ); 1082 } 1083 break; 1084 1085 case SbxEMPTY: 1086 case SbxNULL: 1087 case SbxVOID: 1088 case SbxINTEGER: 1089 case SbxUSHORT: 1090 case SbxINT: 1091 case SbxUINT: 1092 { 1093 sal_Int16 aInt; 1094 *pStrm >> aInt; 1095 rVar.PutInteger( aInt ); 1096 } 1097 break; 1098 1099 case SbxLONG: 1100 case SbxULONG: 1101 case SbxLONG64: 1102 case SbxULONG64: 1103 { 1104 sal_Int32 aInt; 1105 *pStrm >> aInt; 1106 rVar.PutLong( aInt ); 1107 } 1108 break; 1109 1110 case SbxSINGLE: 1111 { 1112 float nS; 1113 *pStrm >> nS; 1114 rVar.PutSingle( nS ); 1115 } 1116 break; 1117 1118 case SbxDOUBLE: 1119 case SbxCURRENCY: 1120 { 1121 *pStrm >> aDouble; 1122 rVar.PutDouble( aDouble ); 1123 } 1124 break; 1125 1126 case SbxDATE: 1127 { 1128 *pStrm >> aDouble; 1129 rVar.PutDate( aDouble ); 1130 } 1131 break; 1132 1133 case SbxSTRING: 1134 case SbxLPSTR: 1135 { 1136 String aStr; 1137 pStrm->ReadByteString( aStr, gsl_getSystemTextEncoding() ); 1138 rVar.PutString( aStr ); 1139 } 1140 break; 1141 1142 default: 1143 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1144 return sal_False; 1145 } 1146 1147 if( nBlockLen ) 1148 pStrm->Seek( nFPos + nBlockLen ); 1149 return pStrm->GetErrorCode() ? sal_False : sal_True; 1150 } 1151 1152 1153 // nCurDim = 1...n 1154 sal_Bool lcl_WriteReadSbxArray( SbxDimArray& rArr, SvStream* pStrm, 1155 sal_Bool bBinary, short nCurDim, short* pOtherDims, sal_Bool bWrite ) 1156 { 1157 DBG_ASSERT( nCurDim > 0,"Bad Dim"); 1158 short nLower, nUpper; 1159 if( !rArr.GetDim( nCurDim, nLower, nUpper ) ) 1160 return sal_False; 1161 for( short nCur = nLower; nCur <= nUpper; nCur++ ) 1162 { 1163 pOtherDims[ nCurDim-1 ] = nCur; 1164 if( nCurDim != 1 ) 1165 lcl_WriteReadSbxArray(rArr, pStrm, bBinary, nCurDim-1, pOtherDims, bWrite); 1166 else 1167 { 1168 SbxVariable* pVar = rArr.Get( (const short*)pOtherDims ); 1169 sal_Bool bRet; 1170 if( bWrite ) 1171 bRet = lcl_WriteSbxVariable(*pVar, pStrm, bBinary, 0, sal_True ); 1172 else 1173 bRet = lcl_ReadSbxVariable(*pVar, pStrm, bBinary, 0, sal_True ); 1174 if( !bRet ) 1175 return sal_False; 1176 } 1177 } 1178 return sal_True; 1179 } 1180 1181 void PutGet( SbxArray& rPar, sal_Bool bPut ) 1182 { 1183 // Wir brauchen 3 Parameter 1184 if ( rPar.Count() != 4 ) 1185 { 1186 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1187 return; 1188 } 1189 sal_Int16 nFileNo = rPar.Get(1)->GetInteger(); 1190 SbxVariable* pVar2 = rPar.Get(2); 1191 SbxDataType eType2 = pVar2->GetType(); 1192 sal_Bool bHasRecordNo = (sal_Bool)(eType2 != SbxEMPTY && eType2 != SbxERROR); 1193 long nRecordNo = pVar2->GetLong(); 1194 if ( nFileNo < 1 || ( bHasRecordNo && nRecordNo < 1 ) ) 1195 { 1196 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1197 return; 1198 } 1199 nRecordNo--; // wir moegen's ab 0! 1200 SbiIoSystem* pIO = pINST->GetIoSystem(); 1201 SbiStream* pSbStrm = pIO->GetStream( nFileNo ); 1202 // das File muss Random (feste Record-Laenge) oder Binary sein 1203 if ( !pSbStrm || !(pSbStrm->GetMode() & (SBSTRM_BINARY | SBSTRM_RANDOM)) ) 1204 { 1205 StarBASIC::Error( SbERR_BAD_CHANNEL ); 1206 return; 1207 } 1208 1209 SvStream* pStrm = pSbStrm->GetStrm(); 1210 sal_Bool bRandom = pSbStrm->IsRandom(); 1211 short nBlockLen = bRandom ? pSbStrm->GetBlockLen() : 0; 1212 1213 if( bPut ) 1214 { 1215 // Datei aufplustern, falls jemand uebers Dateiende hinaus geseekt hat 1216 pSbStrm->ExpandFile(); 1217 } 1218 1219 // auf die Startposition seeken 1220 if( bHasRecordNo ) 1221 { 1222 sal_uIntPtr nFilePos = bRandom ? (sal_uIntPtr)(nBlockLen*nRecordNo) : (sal_uIntPtr)nRecordNo; 1223 pStrm->Seek( nFilePos ); 1224 } 1225 1226 SbxDimArray* pArr = 0; 1227 SbxVariable* pVar = rPar.Get(3); 1228 if( pVar->GetType() & SbxARRAY ) 1229 { 1230 SbxBase* pParObj = pVar->GetObject(); 1231 pArr = PTR_CAST(SbxDimArray,pParObj); 1232 } 1233 1234 sal_Bool bRet; 1235 1236 if( pArr ) 1237 { 1238 sal_uIntPtr nFPos = pStrm->Tell(); 1239 short nDims = pArr->GetDims(); 1240 short* pDims = new short[ nDims ]; 1241 bRet = lcl_WriteReadSbxArray(*pArr,pStrm,!bRandom,nDims,pDims,bPut); 1242 delete [] pDims; 1243 if( nBlockLen ) 1244 pStrm->Seek( nFPos + nBlockLen ); 1245 } 1246 else 1247 { 1248 if( bPut ) 1249 bRet = lcl_WriteSbxVariable(*pVar, pStrm, !bRandom, nBlockLen, sal_False); 1250 else 1251 bRet = lcl_ReadSbxVariable(*pVar, pStrm, !bRandom, nBlockLen, sal_False); 1252 } 1253 if( !bRet || pStrm->GetErrorCode() ) 1254 StarBASIC::Error( SbERR_IO_ERROR ); 1255 } 1256 1257 RTLFUNC(Put) 1258 { 1259 (void)pBasic; 1260 (void)bWrite; 1261 1262 PutGet( rPar, sal_True ); 1263 } 1264 1265 RTLFUNC(Get) 1266 { 1267 (void)pBasic; 1268 (void)bWrite; 1269 1270 PutGet( rPar, sal_False ); 1271 } 1272 1273 RTLFUNC(Environ) 1274 { 1275 (void)pBasic; 1276 (void)bWrite; 1277 1278 if ( rPar.Count() != 2 ) 1279 { 1280 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1281 return; 1282 } 1283 String aResult; 1284 // sollte ANSI sein, aber unter Win16 in DLL nicht moeglich 1285 ByteString aByteStr( rPar.Get(1)->GetString(), gsl_getSystemTextEncoding() ); 1286 const char* pEnvStr = getenv( aByteStr.GetBuffer() ); 1287 if ( pEnvStr ) 1288 aResult = String::CreateFromAscii( pEnvStr ); 1289 rPar.Get(0)->PutString( aResult ); 1290 } 1291 1292 static double GetDialogZoomFactor( sal_Bool bX, long nValue ) 1293 { 1294 OutputDevice* pDevice = Application::GetDefaultDevice(); 1295 double nResult = 0; 1296 if( pDevice ) 1297 { 1298 Size aRefSize( nValue, nValue ); 1299 Fraction aFracX( 1, 26 ); 1300 Fraction aFracY( 1, 24 ); 1301 MapMode aMap( MAP_APPFONT, Point(), aFracX, aFracY ); 1302 Size aScaledSize = pDevice->LogicToPixel( aRefSize, aMap ); 1303 aRefSize = pDevice->LogicToPixel( aRefSize, MapMode(MAP_TWIP) ); 1304 1305 double nRef, nScaled; 1306 if( bX ) 1307 { 1308 nRef = aRefSize.Width(); 1309 nScaled = aScaledSize.Width(); 1310 } 1311 else 1312 { 1313 nRef = aRefSize.Height(); 1314 nScaled = aScaledSize.Height(); 1315 } 1316 nResult = nScaled / nRef; 1317 } 1318 return nResult; 1319 } 1320 1321 1322 RTLFUNC(GetDialogZoomFactorX) 1323 { 1324 (void)pBasic; 1325 (void)bWrite; 1326 1327 if ( rPar.Count() != 2 ) 1328 { 1329 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1330 return; 1331 } 1332 rPar.Get(0)->PutDouble( GetDialogZoomFactor( sal_True, rPar.Get(1)->GetLong() )); 1333 } 1334 1335 RTLFUNC(GetDialogZoomFactorY) 1336 { 1337 (void)pBasic; 1338 (void)bWrite; 1339 1340 if ( rPar.Count() != 2 ) 1341 { 1342 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1343 return; 1344 } 1345 rPar.Get(0)->PutDouble( GetDialogZoomFactor( sal_False, rPar.Get(1)->GetLong())); 1346 } 1347 1348 1349 RTLFUNC(EnableReschedule) 1350 { 1351 (void)pBasic; 1352 (void)bWrite; 1353 1354 rPar.Get(0)->PutEmpty(); 1355 if ( rPar.Count() != 2 ) 1356 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1357 if( pINST ) 1358 pINST->EnableReschedule( rPar.Get(1)->GetBool() ); 1359 } 1360 1361 RTLFUNC(GetSystemTicks) 1362 { 1363 (void)pBasic; 1364 (void)bWrite; 1365 1366 if ( rPar.Count() != 1 ) 1367 { 1368 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1369 return; 1370 } 1371 rPar.Get(0)->PutLong( Time::GetSystemTicks() ); 1372 } 1373 1374 RTLFUNC(GetPathSeparator) 1375 { 1376 (void)pBasic; 1377 (void)bWrite; 1378 1379 if ( rPar.Count() != 1 ) 1380 { 1381 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1382 return; 1383 } 1384 rPar.Get(0)->PutString( DirEntry::GetAccessDelimiter() ); 1385 } 1386 1387 RTLFUNC(ResolvePath) 1388 { 1389 (void)pBasic; 1390 (void)bWrite; 1391 1392 if ( rPar.Count() == 2 ) 1393 { 1394 String aStr = rPar.Get(1)->GetString(); 1395 DirEntry aEntry( aStr ); 1396 //if( aEntry.IsVirtual() ) 1397 //aStr = aEntry.GetRealPathFromVirtualURL(); 1398 rPar.Get(0)->PutString( aStr ); 1399 } 1400 else 1401 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1402 } 1403 1404 RTLFUNC(TypeLen) 1405 { 1406 (void)pBasic; 1407 (void)bWrite; 1408 1409 if ( rPar.Count() != 2 ) 1410 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1411 else 1412 { 1413 SbxDataType eType = rPar.Get(1)->GetType(); 1414 sal_Int16 nLen = 0; 1415 switch( eType ) 1416 { 1417 case SbxEMPTY: 1418 case SbxNULL: 1419 case SbxVECTOR: 1420 case SbxARRAY: 1421 case SbxBYREF: 1422 case SbxVOID: 1423 case SbxHRESULT: 1424 case SbxPOINTER: 1425 case SbxDIMARRAY: 1426 case SbxCARRAY: 1427 case SbxUSERDEF: 1428 nLen = 0; 1429 break; 1430 1431 case SbxINTEGER: 1432 case SbxERROR: 1433 case SbxUSHORT: 1434 case SbxINT: 1435 case SbxUINT: 1436 nLen = 2; 1437 break; 1438 1439 case SbxLONG: 1440 case SbxSINGLE: 1441 case SbxULONG: 1442 nLen = 4; 1443 break; 1444 1445 case SbxDOUBLE: 1446 case SbxCURRENCY: 1447 case SbxDATE: 1448 case SbxLONG64: 1449 case SbxULONG64: 1450 nLen = 8; 1451 break; 1452 1453 case SbxOBJECT: 1454 case SbxVARIANT: 1455 case SbxDATAOBJECT: 1456 nLen = 0; 1457 break; 1458 1459 case SbxCHAR: 1460 case SbxBYTE: 1461 case SbxBOOL: 1462 nLen = 1; 1463 break; 1464 1465 case SbxLPSTR: 1466 case SbxLPWSTR: 1467 case SbxCoreSTRING: 1468 case SbxSTRING: 1469 nLen = (sal_Int16)rPar.Get(1)->GetString().Len(); 1470 break; 1471 1472 default: 1473 nLen = 0; 1474 } 1475 rPar.Get(0)->PutInteger( nLen ); 1476 } 1477 } 1478 1479 1480 // Uno-Struct eines beliebigen Typs erzeugen 1481 // 1. Parameter == Klassename, weitere Parameter zur Initialisierung 1482 RTLFUNC(CreateUnoStruct) 1483 { 1484 (void)pBasic; 1485 (void)bWrite; 1486 1487 RTL_Impl_CreateUnoStruct( pBasic, rPar, bWrite ); 1488 } 1489 1490 // Uno-Service erzeugen 1491 // 1. Parameter == Service-Name 1492 RTLFUNC(CreateUnoService) 1493 { 1494 (void)pBasic; 1495 (void)bWrite; 1496 1497 RTL_Impl_CreateUnoService( pBasic, rPar, bWrite ); 1498 } 1499 1500 RTLFUNC(CreateUnoServiceWithArguments) 1501 { 1502 (void)pBasic; 1503 (void)bWrite; 1504 1505 RTL_Impl_CreateUnoServiceWithArguments( pBasic, rPar, bWrite ); 1506 } 1507 1508 1509 RTLFUNC(CreateUnoValue) 1510 { 1511 (void)pBasic; 1512 (void)bWrite; 1513 1514 RTL_Impl_CreateUnoValue( pBasic, rPar, bWrite ); 1515 } 1516 1517 1518 // ServiceManager liefern (keine Parameter) 1519 RTLFUNC(GetProcessServiceManager) 1520 { 1521 (void)pBasic; 1522 (void)bWrite; 1523 1524 RTL_Impl_GetProcessServiceManager( pBasic, rPar, bWrite ); 1525 } 1526 1527 // PropertySet erzeugen 1528 // 1. Parameter == Sequence<PropertyValue> 1529 RTLFUNC(CreatePropertySet) 1530 { 1531 (void)pBasic; 1532 (void)bWrite; 1533 1534 RTL_Impl_CreatePropertySet( pBasic, rPar, bWrite ); 1535 } 1536 1537 // Abfragen, ob ein Interface unterstuetzt wird 1538 // Mehrere Interface-Namen als Parameter 1539 RTLFUNC(HasUnoInterfaces) 1540 { 1541 (void)pBasic; 1542 (void)bWrite; 1543 1544 RTL_Impl_HasInterfaces( pBasic, rPar, bWrite ); 1545 } 1546 1547 // Abfragen, ob ein Basic-Objekt ein Uno-Struct repraesentiert 1548 RTLFUNC(IsUnoStruct) 1549 { 1550 (void)pBasic; 1551 (void)bWrite; 1552 1553 RTL_Impl_IsUnoStruct( pBasic, rPar, bWrite ); 1554 } 1555 1556 // Abfragen, ob zwei Uno-Objekte identisch sind 1557 RTLFUNC(EqualUnoObjects) 1558 { 1559 (void)pBasic; 1560 (void)bWrite; 1561 1562 RTL_Impl_EqualUnoObjects( pBasic, rPar, bWrite ); 1563 } 1564 1565 // Instantiate "com.sun.star.awt.UnoControlDialog" on basis 1566 // of a DialogLibrary entry: Convert from XML-ByteSequence 1567 // and attach events. Implemented in classes\eventatt.cxx 1568 void RTL_Impl_CreateUnoDialog( StarBASIC* pBasic, SbxArray& rPar, sal_Bool bWrite ); 1569 1570 RTLFUNC(CreateUnoDialog) 1571 { 1572 (void)pBasic; 1573 (void)bWrite; 1574 1575 RTL_Impl_CreateUnoDialog( pBasic, rPar, bWrite ); 1576 } 1577 1578 // Return the application standard lib as root scope 1579 RTLFUNC(GlobalScope) 1580 { 1581 (void)pBasic; 1582 (void)bWrite; 1583 1584 SbxObject* p = pBasic; 1585 while( p->GetParent() ) 1586 p = p->GetParent(); 1587 1588 SbxVariableRef refVar = rPar.Get(0); 1589 refVar->PutObject( p ); 1590 } 1591 1592 // Helper functions to convert Url from/to system paths 1593 RTLFUNC(ConvertToUrl) 1594 { 1595 (void)pBasic; 1596 (void)bWrite; 1597 1598 if ( rPar.Count() == 2 ) 1599 { 1600 String aStr = rPar.Get(1)->GetString(); 1601 INetURLObject aURLObj( aStr, INET_PROT_FILE ); 1602 ::rtl::OUString aFileURL = aURLObj.GetMainURL( INetURLObject::NO_DECODE ); 1603 if( aFileURL.isEmpty() ) 1604 ::osl::File::getFileURLFromSystemPath( aFileURL, aFileURL ); 1605 if( aFileURL.isEmpty() ) 1606 aFileURL = aStr; 1607 rPar.Get(0)->PutString( String(aFileURL) ); 1608 } 1609 else 1610 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1611 } 1612 1613 RTLFUNC(ConvertFromUrl) 1614 { 1615 (void)pBasic; 1616 (void)bWrite; 1617 1618 if ( rPar.Count() == 2 ) 1619 { 1620 String aStr = rPar.Get(1)->GetString(); 1621 ::rtl::OUString aSysPath; 1622 ::osl::File::getSystemPathFromFileURL( aStr, aSysPath ); 1623 if( aSysPath.isEmpty() ) 1624 aSysPath = aStr; 1625 rPar.Get(0)->PutString( String(aSysPath) ); 1626 } 1627 else 1628 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1629 } 1630 1631 1632 // Provide DefaultContext 1633 RTLFUNC(GetDefaultContext) 1634 { 1635 (void)pBasic; 1636 (void)bWrite; 1637 1638 RTL_Impl_GetDefaultContext( pBasic, rPar, bWrite ); 1639 } 1640 1641 #ifdef DBG_TRACE_BASIC 1642 RTLFUNC(TraceCommand) 1643 { 1644 RTL_Impl_TraceCommand( pBasic, rPar, bWrite ); 1645 } 1646 #endif 1647 1648 RTLFUNC(Join) 1649 { 1650 (void)pBasic; 1651 (void)bWrite; 1652 1653 sal_uInt16 nParCount = rPar.Count(); 1654 if ( nParCount != 3 && nParCount != 2 ) 1655 { 1656 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1657 return; 1658 } 1659 SbxBase* pParObj = rPar.Get(1)->GetObject(); 1660 SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj); 1661 if( pArr ) 1662 { 1663 if( pArr->GetDims() != 1 ) 1664 StarBASIC::Error( SbERR_WRONG_DIMS ); // Syntax Error?! 1665 1666 String aDelim; 1667 if( nParCount == 3 ) 1668 aDelim = rPar.Get(2)->GetString(); 1669 else 1670 aDelim = String::CreateFromAscii( " " ); 1671 1672 String aRetStr; 1673 short nLower, nUpper; 1674 pArr->GetDim( 1, nLower, nUpper ); 1675 for( short i = nLower ; i <= nUpper ; ++i ) 1676 { 1677 String aStr = pArr->Get( &i )->GetString(); 1678 aRetStr += aStr; 1679 if( i != nUpper ) 1680 aRetStr += aDelim; 1681 } 1682 rPar.Get(0)->PutString( aRetStr ); 1683 } 1684 else 1685 StarBASIC::Error( SbERR_MUST_HAVE_DIMS ); 1686 } 1687 1688 1689 RTLFUNC(Split) 1690 { 1691 (void)pBasic; 1692 (void)bWrite; 1693 1694 sal_uInt16 nParCount = rPar.Count(); 1695 if ( nParCount < 2 ) 1696 { 1697 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1698 return; 1699 } 1700 1701 String aExpression = rPar.Get(1)->GetString(); 1702 short nArraySize = 0; 1703 StringVector vRet; 1704 if( aExpression.Len() ) 1705 { 1706 String aDelim; 1707 if( nParCount >= 3 ) 1708 aDelim = rPar.Get(2)->GetString(); 1709 else 1710 aDelim = String::CreateFromAscii( " " ); 1711 1712 sal_Int32 nCount = -1; 1713 if( nParCount == 4 ) 1714 nCount = rPar.Get(3)->GetLong(); 1715 1716 xub_StrLen nDelimLen = aDelim.Len(); 1717 if( nDelimLen ) 1718 { 1719 xub_StrLen iSearch = STRING_NOTFOUND; 1720 xub_StrLen iStart = 0; 1721 do 1722 { 1723 bool bBreak = false; 1724 if( nCount >= 0 && nArraySize == nCount - 1 ) 1725 bBreak = true; 1726 1727 iSearch = aExpression.Search( aDelim, iStart ); 1728 String aSubStr; 1729 if( iSearch != STRING_NOTFOUND && !bBreak ) 1730 { 1731 aSubStr = aExpression.Copy( iStart, iSearch - iStart ); 1732 iStart = iSearch + nDelimLen; 1733 } 1734 else 1735 { 1736 aSubStr = aExpression.Copy( iStart ); 1737 } 1738 vRet.push_back( aSubStr ); 1739 nArraySize++; 1740 1741 if( bBreak ) 1742 break; 1743 } 1744 while( iSearch != STRING_NOTFOUND ); 1745 } 1746 else 1747 { 1748 vRet.push_back( aExpression ); 1749 nArraySize = 1; 1750 } 1751 } 1752 1753 SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); 1754 pArray->unoAddDim( 0, nArraySize-1 ); 1755 1756 // Parameter ins Array uebernehmen 1757 for( short i = 0 ; i < nArraySize ; i++ ) 1758 { 1759 SbxVariableRef xVar = new SbxVariable( SbxVARIANT ); 1760 xVar->PutString( vRet[i] ); 1761 pArray->Put( (SbxVariable*)xVar, &i ); 1762 } 1763 1764 // Array zurueckliefern 1765 SbxVariableRef refVar = rPar.Get(0); 1766 sal_uInt16 nFlags = refVar->GetFlags(); 1767 refVar->ResetFlag( SBX_FIXED ); 1768 refVar->PutObject( pArray ); 1769 refVar->SetFlags( nFlags ); 1770 refVar->SetParameters( NULL ); 1771 } 1772 1773 // MonthName(month[, abbreviate]) 1774 RTLFUNC(MonthName) 1775 { 1776 (void)pBasic; 1777 (void)bWrite; 1778 1779 sal_uInt16 nParCount = rPar.Count(); 1780 if( nParCount != 2 && nParCount != 3 ) 1781 { 1782 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1783 return; 1784 } 1785 1786 Reference< XCalendar > xCalendar = getLocaleCalendar(); 1787 if( !xCalendar.is() ) 1788 { 1789 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 1790 return; 1791 } 1792 Sequence< CalendarItem > aMonthSeq = xCalendar->getMonths(); 1793 sal_Int32 nMonthCount = aMonthSeq.getLength(); 1794 1795 sal_Int16 nVal = rPar.Get(1)->GetInteger(); 1796 if( nVal < 1 || nVal > nMonthCount ) 1797 { 1798 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1799 return; 1800 } 1801 1802 sal_Bool bAbbreviate = false; 1803 if( nParCount == 3 ) 1804 bAbbreviate = rPar.Get(2)->GetBool(); 1805 1806 const CalendarItem* pCalendarItems = aMonthSeq.getConstArray(); 1807 const CalendarItem& rItem = pCalendarItems[nVal - 1]; 1808 1809 ::rtl::OUString aRetStr = ( bAbbreviate ? rItem.AbbrevName : rItem.FullName ); 1810 rPar.Get(0)->PutString( String(aRetStr) ); 1811 } 1812 1813 // WeekdayName(weekday, abbreviate, firstdayofweek) 1814 RTLFUNC(WeekdayName) 1815 { 1816 (void)pBasic; 1817 (void)bWrite; 1818 1819 sal_uInt16 nParCount = rPar.Count(); 1820 if( nParCount < 2 || nParCount > 4 ) 1821 { 1822 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1823 return; 1824 } 1825 1826 Reference< XCalendar > xCalendar = getLocaleCalendar(); 1827 if( !xCalendar.is() ) 1828 { 1829 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 1830 return; 1831 } 1832 1833 Sequence< CalendarItem > aDaySeq = xCalendar->getDays(); 1834 sal_Int16 nDayCount = (sal_Int16)aDaySeq.getLength(); 1835 sal_Int16 nDay = rPar.Get(1)->GetInteger(); 1836 sal_Int16 nFirstDay = 0; 1837 if( nParCount == 4 ) 1838 { 1839 nFirstDay = rPar.Get(3)->GetInteger(); 1840 if( nFirstDay < 0 || nFirstDay > 7 ) 1841 { 1842 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1843 return; 1844 } 1845 } 1846 if( nFirstDay == 0 ) 1847 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 1848 1849 nDay = 1 + (nDay + nDayCount + nFirstDay - 2) % nDayCount; 1850 if( nDay < 1 || nDay > nDayCount ) 1851 { 1852 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1853 return; 1854 } 1855 1856 sal_Bool bAbbreviate = false; 1857 if( nParCount >= 3 ) 1858 { 1859 SbxVariable* pPar2 = rPar.Get(2); 1860 if( !pPar2->IsErr() ) 1861 bAbbreviate = pPar2->GetBool(); 1862 } 1863 1864 const CalendarItem* pCalendarItems = aDaySeq.getConstArray(); 1865 const CalendarItem& rItem = pCalendarItems[nDay - 1]; 1866 1867 ::rtl::OUString aRetStr = ( bAbbreviate ? rItem.AbbrevName : rItem.FullName ); 1868 rPar.Get(0)->PutString( String(aRetStr) ); 1869 } 1870 1871 sal_Int16 implGetWeekDay( double aDate, bool bFirstDayParam = false, sal_Int16 nFirstDay = 0 ) 1872 { 1873 Date aRefDate( 1,1,1900 ); 1874 long nDays = (long) aDate; 1875 nDays -= 2; // normieren: 1.1.1900 => 0 1876 aRefDate += nDays; 1877 DayOfWeek aDay = aRefDate.GetDayOfWeek(); 1878 sal_Int16 nDay; 1879 if ( aDay != SUNDAY ) 1880 nDay = (sal_Int16)aDay + 2; 1881 else 1882 nDay = 1; // 1==Sonntag 1883 1884 // #117253 Optional 2. parameter "firstdayofweek" 1885 if( bFirstDayParam ) 1886 { 1887 if( nFirstDay < 0 || nFirstDay > 7 ) 1888 { 1889 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1890 return 0; 1891 } 1892 if( nFirstDay == 0 ) 1893 { 1894 Reference< XCalendar > xCalendar = getLocaleCalendar(); 1895 if( !xCalendar.is() ) 1896 { 1897 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 1898 return 0; 1899 } 1900 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 1901 } 1902 nDay = 1 + (nDay + 7 - nFirstDay) % 7; 1903 } 1904 return nDay; 1905 } 1906 1907 RTLFUNC(Weekday) 1908 { 1909 (void)pBasic; 1910 (void)bWrite; 1911 1912 sal_uInt16 nParCount = rPar.Count(); 1913 if ( nParCount < 2 ) 1914 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 1915 else 1916 { 1917 double aDate = rPar.Get(1)->GetDate(); 1918 1919 bool bFirstDay = false; 1920 sal_Int16 nFirstDay = 0; 1921 if ( nParCount > 2 ) 1922 { 1923 nFirstDay = rPar.Get(2)->GetInteger(); 1924 bFirstDay = true; 1925 } 1926 sal_Int16 nDay = implGetWeekDay( aDate, bFirstDay, nFirstDay ); 1927 rPar.Get(0)->PutInteger( nDay ); 1928 } 1929 } 1930 1931 1932 enum Interval 1933 { 1934 INTERVAL_NONE, 1935 INTERVAL_YYYY, 1936 INTERVAL_Q, 1937 INTERVAL_M, 1938 INTERVAL_Y, 1939 INTERVAL_D, 1940 INTERVAL_W, 1941 INTERVAL_WW, 1942 INTERVAL_H, 1943 INTERVAL_N, 1944 INTERVAL_S 1945 }; 1946 1947 struct IntervalInfo 1948 { 1949 Interval meInterval; 1950 const char* mpStringCode; 1951 double mdValue; 1952 bool mbSimple; 1953 1954 IntervalInfo( Interval eInterval, const char* pStringCode, double dValue, bool bSimple ) 1955 : meInterval( eInterval ) 1956 , mpStringCode( pStringCode ) 1957 , mdValue( dValue ) 1958 , mbSimple( bSimple ) 1959 {} 1960 }; 1961 1962 static IntervalInfo pIntervalTable[] = 1963 { 1964 IntervalInfo( INTERVAL_YYYY, "yyyy", 0.0, false ), // Year 1965 IntervalInfo( INTERVAL_Q, "q", 0.0, false ), // Quarter 1966 IntervalInfo( INTERVAL_M, "m", 0.0, false ), // Month 1967 IntervalInfo( INTERVAL_Y, "y", 1.0, true ), // Day of year 1968 IntervalInfo( INTERVAL_D, "d", 1.0, true ), // Day 1969 IntervalInfo( INTERVAL_W, "w", 1.0, true ), // Weekday 1970 IntervalInfo( INTERVAL_WW, "ww", 7.0, true ), // Week 1971 IntervalInfo( INTERVAL_H, "h", (1.0 / 24.0), true ), // Hour 1972 IntervalInfo( INTERVAL_N, "n", (1.0 / 1440.0), true), // Minute 1973 IntervalInfo( INTERVAL_S, "s", (1.0 / 86400.0), true ), // Second 1974 IntervalInfo( INTERVAL_NONE, NULL, 0.0, false ) 1975 }; 1976 1977 IntervalInfo* getIntervalInfo( const String& rStringCode ) 1978 { 1979 IntervalInfo* pInfo = NULL; 1980 sal_Int16 i = 0; 1981 while( (pInfo = pIntervalTable + i)->mpStringCode != NULL ) 1982 { 1983 if( rStringCode.EqualsIgnoreCaseAscii( pInfo->mpStringCode ) ) 1984 break; 1985 i++; 1986 } 1987 return pInfo; 1988 } 1989 1990 // From methods.cxx 1991 sal_Bool implDateSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay, double& rdRet ); 1992 sal_Int16 implGetDateDay( double aDate ); 1993 sal_Int16 implGetDateMonth( double aDate ); 1994 sal_Int16 implGetDateYear( double aDate ); 1995 1996 sal_Int16 implGetHour( double dDate ); 1997 sal_Int16 implGetMinute( double dDate ); 1998 sal_Int16 implGetSecond( double dDate ); 1999 2000 2001 inline void implGetDayMonthYear( sal_Int16& rnYear, sal_Int16& rnMonth, sal_Int16& rnDay, double dDate ) 2002 { 2003 rnDay = implGetDateDay( dDate ); 2004 rnMonth = implGetDateMonth( dDate ); 2005 rnYear = implGetDateYear( dDate ); 2006 } 2007 2008 inline sal_Int16 limitToINT16( sal_Int32 n32 ) 2009 { 2010 if( n32 > 32767 ) 2011 n32 = 32767; 2012 else if( n32 < -32768 ) 2013 n32 = -32768; 2014 return (sal_Int16)n32; 2015 } 2016 2017 RTLFUNC(DateAdd) 2018 { 2019 (void)pBasic; 2020 (void)bWrite; 2021 2022 sal_uInt16 nParCount = rPar.Count(); 2023 if( nParCount != 4 ) 2024 { 2025 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2026 return; 2027 } 2028 2029 String aStringCode = rPar.Get(1)->GetString(); 2030 IntervalInfo* pInfo = getIntervalInfo( aStringCode ); 2031 if( !pInfo ) 2032 { 2033 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2034 return; 2035 } 2036 2037 sal_Int32 lNumber = rPar.Get(2)->GetLong(); 2038 double dDate = rPar.Get(3)->GetDate(); 2039 double dNewDate = 0; 2040 if( pInfo->mbSimple ) 2041 { 2042 double dAdd = pInfo->mdValue * lNumber; 2043 dNewDate = dDate + dAdd; 2044 } 2045 else 2046 { 2047 // Keep hours, minutes, seconds 2048 double dHoursMinutesSeconds = dDate - floor( dDate ); 2049 2050 sal_Bool bOk = sal_True; 2051 sal_Int16 nYear, nMonth, nDay; 2052 sal_Int16 nTargetYear16 = 0, nTargetMonth = 0; 2053 implGetDayMonthYear( nYear, nMonth, nDay, dDate ); 2054 switch( pInfo->meInterval ) 2055 { 2056 case INTERVAL_YYYY: 2057 { 2058 sal_Int32 nTargetYear = lNumber + nYear; 2059 nTargetYear16 = limitToINT16( nTargetYear ); 2060 nTargetMonth = nMonth; 2061 bOk = implDateSerial( nTargetYear16, nTargetMonth, nDay, dNewDate ); 2062 break; 2063 } 2064 case INTERVAL_Q: 2065 case INTERVAL_M: 2066 { 2067 bool bNeg = (lNumber < 0); 2068 if( bNeg ) 2069 lNumber = -lNumber; 2070 sal_Int32 nYearsAdd; 2071 sal_Int16 nMonthAdd; 2072 if( pInfo->meInterval == INTERVAL_Q ) 2073 { 2074 nYearsAdd = lNumber / 4; 2075 nMonthAdd = (sal_Int16)( 3 * (lNumber % 4) ); 2076 } 2077 else 2078 { 2079 nYearsAdd = lNumber / 12; 2080 nMonthAdd = (sal_Int16)( lNumber % 12 ); 2081 } 2082 2083 sal_Int32 nTargetYear; 2084 if( bNeg ) 2085 { 2086 nTargetMonth = nMonth - nMonthAdd; 2087 if( nTargetMonth <= 0 ) 2088 { 2089 nTargetMonth += 12; 2090 nYearsAdd++; 2091 } 2092 nTargetYear = (sal_Int32)nYear - nYearsAdd; 2093 } 2094 else 2095 { 2096 nTargetMonth = nMonth + nMonthAdd; 2097 if( nTargetMonth > 12 ) 2098 { 2099 nTargetMonth -= 12; 2100 nYearsAdd++; 2101 } 2102 nTargetYear = (sal_Int32)nYear + nYearsAdd; 2103 } 2104 nTargetYear16 = limitToINT16( nTargetYear ); 2105 bOk = implDateSerial( nTargetYear16, nTargetMonth, nDay, dNewDate ); 2106 break; 2107 } 2108 default: break; 2109 } 2110 2111 if( bOk ) 2112 { 2113 // Overflow? 2114 sal_Int16 nNewYear, nNewMonth, nNewDay; 2115 implGetDayMonthYear( nNewYear, nNewMonth, nNewDay, dNewDate ); 2116 if( nNewYear > 9999 || nNewYear < 100 ) 2117 { 2118 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2119 return; 2120 } 2121 sal_Int16 nCorrectionDay = nDay; 2122 while( nNewMonth > nTargetMonth ) 2123 { 2124 nCorrectionDay--; 2125 implDateSerial( nTargetYear16, nTargetMonth, nCorrectionDay, dNewDate ); 2126 implGetDayMonthYear( nNewYear, nNewMonth, nNewDay, dNewDate ); 2127 } 2128 dNewDate += dHoursMinutesSeconds; 2129 } 2130 } 2131 2132 rPar.Get(0)->PutDate( dNewDate ); 2133 } 2134 2135 inline double RoundImpl( double d ) 2136 { 2137 return ( d >= 0 ) ? floor( d + 0.5 ) : -floor( -d + 0.5 ); 2138 } 2139 2140 RTLFUNC(DateDiff) 2141 { 2142 (void)pBasic; 2143 (void)bWrite; 2144 2145 // DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]]) 2146 2147 sal_uInt16 nParCount = rPar.Count(); 2148 if( nParCount < 4 || nParCount > 6 ) 2149 { 2150 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2151 return; 2152 } 2153 2154 String aStringCode = rPar.Get(1)->GetString(); 2155 IntervalInfo* pInfo = getIntervalInfo( aStringCode ); 2156 if( !pInfo ) 2157 { 2158 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2159 return; 2160 } 2161 2162 double dDate1 = rPar.Get(2)->GetDate(); 2163 double dDate2 = rPar.Get(3)->GetDate(); 2164 2165 double dRet = 0.0; 2166 switch( pInfo->meInterval ) 2167 { 2168 case INTERVAL_YYYY: 2169 { 2170 sal_Int16 nYear1 = implGetDateYear( dDate1 ); 2171 sal_Int16 nYear2 = implGetDateYear( dDate2 ); 2172 dRet = nYear2 - nYear1; 2173 break; 2174 } 2175 case INTERVAL_Q: 2176 { 2177 sal_Int16 nYear1 = implGetDateYear( dDate1 ); 2178 sal_Int16 nYear2 = implGetDateYear( dDate2 ); 2179 sal_Int16 nQ1 = 1 + (implGetDateMonth( dDate1 ) - 1) / 3; 2180 sal_Int16 nQ2 = 1 + (implGetDateMonth( dDate2 ) - 1) / 3; 2181 sal_Int16 nQGes1 = 4 * nYear1 + nQ1; 2182 sal_Int16 nQGes2 = 4 * nYear2 + nQ2; 2183 dRet = nQGes2 - nQGes1; 2184 break; 2185 } 2186 case INTERVAL_M: 2187 { 2188 sal_Int16 nYear1 = implGetDateYear( dDate1 ); 2189 sal_Int16 nYear2 = implGetDateYear( dDate2 ); 2190 sal_Int16 nMonth1 = implGetDateMonth( dDate1 ); 2191 sal_Int16 nMonth2 = implGetDateMonth( dDate2 ); 2192 sal_Int16 nMonthGes1 = 12 * nYear1 + nMonth1; 2193 sal_Int16 nMonthGes2 = 12 * nYear2 + nMonth2; 2194 dRet = nMonthGes2 - nMonthGes1; 2195 break; 2196 } 2197 case INTERVAL_Y: 2198 case INTERVAL_D: 2199 { 2200 double dDays1 = floor( dDate1 ); 2201 double dDays2 = floor( dDate2 ); 2202 dRet = dDays2 - dDays1; 2203 break; 2204 } 2205 case INTERVAL_W: 2206 case INTERVAL_WW: 2207 { 2208 double dDays1 = floor( dDate1 ); 2209 double dDays2 = floor( dDate2 ); 2210 if( pInfo->meInterval == INTERVAL_WW ) 2211 { 2212 sal_Int16 nFirstDay = 1; // Default 2213 if( nParCount >= 5 ) 2214 { 2215 nFirstDay = rPar.Get(4)->GetInteger(); 2216 if( nFirstDay < 0 || nFirstDay > 7 ) 2217 { 2218 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2219 return; 2220 } 2221 if( nFirstDay == 0 ) 2222 { 2223 Reference< XCalendar > xCalendar = getLocaleCalendar(); 2224 if( !xCalendar.is() ) 2225 { 2226 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 2227 return; 2228 } 2229 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 2230 } 2231 } 2232 sal_Int16 nDay1 = implGetWeekDay( dDate1 ); 2233 sal_Int16 nDay1_Diff = nDay1 - nFirstDay; 2234 if( nDay1_Diff < 0 ) 2235 nDay1_Diff += 7; 2236 dDays1 -= nDay1_Diff; 2237 2238 sal_Int16 nDay2 = implGetWeekDay( dDate2 ); 2239 sal_Int16 nDay2_Diff = nDay2 - nFirstDay; 2240 if( nDay2_Diff < 0 ) 2241 nDay2_Diff += 7; 2242 dDays2 -= nDay2_Diff; 2243 } 2244 2245 double dDiff = dDays2 - dDays1; 2246 dRet = ( dDiff >= 0 ) ? floor( dDiff / 7.0 ) : -floor( -dDiff / 7.0 ); 2247 break; 2248 } 2249 case INTERVAL_H: 2250 { 2251 double dFactor = 24.0; 2252 dRet = RoundImpl( dFactor * (dDate2 - dDate1) ); 2253 break; 2254 } 2255 case INTERVAL_N: 2256 { 2257 double dFactor =1440.0; 2258 dRet = RoundImpl( dFactor * (dDate2 - dDate1) ); 2259 break; 2260 } 2261 case INTERVAL_S: 2262 { 2263 double dFactor = 86400.0; 2264 dRet = RoundImpl( dFactor * (dDate2 - dDate1) ); 2265 break; 2266 } 2267 case INTERVAL_NONE: 2268 break; 2269 } 2270 rPar.Get(0)->PutDouble( dRet ); 2271 } 2272 2273 double implGetDateOfFirstDayInFirstWeek 2274 ( sal_Int16 nYear, sal_Int16& nFirstDay, sal_Int16& nFirstWeek, bool* pbError = NULL ) 2275 { 2276 SbError nError = 0; 2277 if( nFirstDay < 0 || nFirstDay > 7 ) 2278 nError = SbERR_BAD_ARGUMENT; 2279 2280 if( nFirstWeek < 0 || nFirstWeek > 3 ) 2281 nError = SbERR_BAD_ARGUMENT; 2282 2283 Reference< XCalendar > xCalendar; 2284 if( nFirstDay == 0 || nFirstWeek == 0 ) 2285 { 2286 xCalendar = getLocaleCalendar(); 2287 if( !xCalendar.is() ) 2288 nError = SbERR_BAD_ARGUMENT; 2289 } 2290 2291 if( nError != 0 ) 2292 { 2293 StarBASIC::Error( nError ); 2294 if( pbError ) 2295 *pbError = true; 2296 return 0.0; 2297 } 2298 2299 if( nFirstDay == 0 ) 2300 nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 ); 2301 2302 sal_Int16 nFirstWeekMinDays = 0; // Not used for vbFirstJan1 = default 2303 if( nFirstWeek == 0 ) 2304 { 2305 nFirstWeekMinDays = xCalendar->getMinimumNumberOfDaysForFirstWeek(); 2306 if( nFirstWeekMinDays == 1 ) 2307 { 2308 nFirstWeekMinDays = 0; 2309 nFirstWeek = 1; 2310 } 2311 else if( nFirstWeekMinDays == 4 ) 2312 nFirstWeek = 2; 2313 else if( nFirstWeekMinDays == 7 ) 2314 nFirstWeek = 3; 2315 } 2316 else if( nFirstWeek == 2 ) 2317 nFirstWeekMinDays = 4; // vbFirstFourDays 2318 else if( nFirstWeek == 3 ) 2319 nFirstWeekMinDays = 7; // vbFirstFourDays 2320 2321 double dBaseDate; 2322 implDateSerial( nYear, 1, 1, dBaseDate ); 2323 double dRetDate = dBaseDate; 2324 2325 sal_Int16 nWeekDay0101 = implGetWeekDay( dBaseDate ); 2326 sal_Int16 nDayDiff = nWeekDay0101 - nFirstDay; 2327 if( nDayDiff < 0 ) 2328 nDayDiff += 7; 2329 2330 if( nFirstWeekMinDays ) 2331 { 2332 sal_Int16 nThisWeeksDaysInYearCount = 7 - nDayDiff; 2333 if( nThisWeeksDaysInYearCount < nFirstWeekMinDays ) 2334 nDayDiff -= 7; 2335 } 2336 dRetDate = dBaseDate - nDayDiff; 2337 return dRetDate; 2338 } 2339 2340 RTLFUNC(DatePart) 2341 { 2342 (void)pBasic; 2343 (void)bWrite; 2344 2345 // DatePart(interval, date[,firstdayofweek[, firstweekofyear]]) 2346 2347 sal_uInt16 nParCount = rPar.Count(); 2348 if( nParCount < 3 || nParCount > 5 ) 2349 { 2350 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2351 return; 2352 } 2353 2354 String aStringCode = rPar.Get(1)->GetString(); 2355 IntervalInfo* pInfo = getIntervalInfo( aStringCode ); 2356 if( !pInfo ) 2357 { 2358 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2359 return; 2360 } 2361 2362 double dDate = rPar.Get(2)->GetDate(); 2363 2364 sal_Int32 nRet = 0; 2365 switch( pInfo->meInterval ) 2366 { 2367 case INTERVAL_YYYY: 2368 { 2369 nRet = implGetDateYear( dDate ); 2370 break; 2371 } 2372 case INTERVAL_Q: 2373 { 2374 nRet = 1 + (implGetDateMonth( dDate ) - 1) / 3; 2375 break; 2376 } 2377 case INTERVAL_M: 2378 { 2379 nRet = implGetDateMonth( dDate ); 2380 break; 2381 } 2382 case INTERVAL_Y: 2383 { 2384 sal_Int16 nYear = implGetDateYear( dDate ); 2385 double dBaseDate; 2386 implDateSerial( nYear, 1, 1, dBaseDate ); 2387 nRet = 1 + sal_Int32( dDate - dBaseDate ); 2388 break; 2389 } 2390 case INTERVAL_D: 2391 { 2392 nRet = implGetDateDay( dDate ); 2393 break; 2394 } 2395 case INTERVAL_W: 2396 { 2397 bool bFirstDay = false; 2398 sal_Int16 nFirstDay = 1; // Default 2399 if( nParCount >= 4 ) 2400 { 2401 nFirstDay = rPar.Get(3)->GetInteger(); 2402 bFirstDay = true; 2403 } 2404 nRet = implGetWeekDay( dDate, bFirstDay, nFirstDay ); 2405 break; 2406 } 2407 case INTERVAL_WW: 2408 { 2409 sal_Int16 nFirstDay = 1; // Default 2410 if( nParCount >= 4 ) 2411 nFirstDay = rPar.Get(3)->GetInteger(); 2412 2413 sal_Int16 nFirstWeek = 1; // Default 2414 if( nParCount == 5 ) 2415 nFirstWeek = rPar.Get(4)->GetInteger(); 2416 2417 sal_Int16 nYear = implGetDateYear( dDate ); 2418 bool bError = false; 2419 double dYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear, nFirstDay, nFirstWeek, &bError ); 2420 if( !bError ) 2421 { 2422 if( dYearFirstDay > dDate ) 2423 { 2424 // Date belongs to last year's week 2425 dYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear - 1, nFirstDay, nFirstWeek ); 2426 } 2427 else if( nFirstWeek != 1 ) 2428 { 2429 // Check if date belongs to next year 2430 double dNextYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear + 1, nFirstDay, nFirstWeek ); 2431 if( dDate >= dNextYearFirstDay ) 2432 dYearFirstDay = dNextYearFirstDay; 2433 } 2434 2435 // Calculate week 2436 double dDiff = dDate - dYearFirstDay; 2437 nRet = 1 + sal_Int32( dDiff / 7 ); 2438 } 2439 break; 2440 } 2441 case INTERVAL_H: 2442 { 2443 nRet = implGetHour( dDate ); 2444 break; 2445 } 2446 case INTERVAL_N: 2447 { 2448 nRet = implGetMinute( dDate ); 2449 break; 2450 } 2451 case INTERVAL_S: 2452 { 2453 nRet = implGetSecond( dDate ); 2454 break; 2455 } 2456 case INTERVAL_NONE: 2457 break; 2458 } 2459 rPar.Get(0)->PutLong( nRet ); 2460 } 2461 2462 // FormatDateTime(Date[,NamedFormat]) 2463 RTLFUNC(FormatDateTime) 2464 { 2465 (void)pBasic; 2466 (void)bWrite; 2467 2468 sal_uInt16 nParCount = rPar.Count(); 2469 if( nParCount < 2 || nParCount > 3 ) 2470 { 2471 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2472 return; 2473 } 2474 2475 double dDate = rPar.Get(1)->GetDate(); 2476 sal_Int16 nNamedFormat = 0; 2477 if( nParCount > 2 ) 2478 { 2479 nNamedFormat = rPar.Get(2)->GetInteger(); 2480 if( nNamedFormat < 0 || nNamedFormat > 4 ) 2481 { 2482 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2483 return; 2484 } 2485 } 2486 2487 Reference< XCalendar > xCalendar = getLocaleCalendar(); 2488 if( !xCalendar.is() ) 2489 { 2490 StarBASIC::Error( SbERR_INTERNAL_ERROR ); 2491 return; 2492 } 2493 2494 String aRetStr; 2495 SbxVariableRef pSbxVar = new SbxVariable( SbxSTRING ); 2496 switch( nNamedFormat ) 2497 { 2498 // GeneralDate: 2499 // Display a date and/or time. If there is a date part, 2500 // display it as a short date. If there is a time part, 2501 // display it as a long time. If present, both parts are displayed. 2502 2503 // 12/21/2004 11:24:50 AM 2504 // 21.12.2004 12:13:51 2505 case 0: 2506 pSbxVar->PutDate( dDate ); 2507 aRetStr = pSbxVar->GetString(); 2508 break; 2509 2510 // LongDate: Display a date using the long date format specified 2511 // in your computer's regional settings. 2512 // Tuesday, December 21, 2004 2513 // Dienstag, 21. December 2004 2514 case 1: 2515 { 2516 SvNumberFormatter* pFormatter = NULL; 2517 if( pINST ) 2518 pFormatter = pINST->GetNumberFormatter(); 2519 else 2520 { 2521 sal_uInt32 n; // Dummy 2522 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n ); 2523 } 2524 2525 LanguageType eLangType = GetpApp()->GetSettings().GetLanguage(); 2526 sal_uIntPtr nIndex = pFormatter->GetFormatIndex( NF_DATE_SYSTEM_LONG, eLangType ); 2527 Color* pCol; 2528 pFormatter->GetOutputString( dDate, nIndex, aRetStr, &pCol ); 2529 2530 if( !pINST ) 2531 delete pFormatter; 2532 2533 break; 2534 } 2535 2536 // ShortDate: Display a date using the short date format specified 2537 // in your computer's regional settings. 2538 // 12/21/2004 2539 // 21.12.2004 2540 case 2: 2541 pSbxVar->PutDate( floor(dDate) ); 2542 aRetStr = pSbxVar->GetString(); 2543 break; 2544 2545 // LongTime: Display a time using the time format specified 2546 // in your computer's regional settings. 2547 // 11:24:50 AM 2548 // 12:13:51 2549 case 3: 2550 // ShortTime: Display a time using the 24-hour format (hh:mm). 2551 // 11:24 2552 case 4: 2553 double n; 2554 double dTime = modf( dDate, &n ); 2555 pSbxVar->PutDate( dTime ); 2556 if( nNamedFormat == 3 ) 2557 aRetStr = pSbxVar->GetString(); 2558 else 2559 aRetStr = pSbxVar->GetString().Copy( 0, 5 ); 2560 break; 2561 } 2562 2563 rPar.Get(0)->PutString( aRetStr ); 2564 } 2565 2566 RTLFUNC(Round) 2567 { 2568 (void)pBasic; 2569 (void)bWrite; 2570 2571 sal_uInt16 nParCount = rPar.Count(); 2572 if( nParCount != 2 && nParCount != 3 ) 2573 { 2574 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2575 return; 2576 } 2577 2578 SbxVariable *pSbxVariable = rPar.Get(1); 2579 double dVal = pSbxVariable->GetDouble(); 2580 double dRes = 0.0; 2581 if( dVal != 0.0 ) 2582 { 2583 bool bNeg = false; 2584 if( dVal < 0.0 ) 2585 { 2586 bNeg = true; 2587 dVal = -dVal; 2588 } 2589 2590 sal_Int16 numdecimalplaces = 0; 2591 if( nParCount == 3 ) 2592 { 2593 numdecimalplaces = rPar.Get(2)->GetInteger(); 2594 if( numdecimalplaces < 0 || numdecimalplaces > 22 ) 2595 { 2596 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2597 return; 2598 } 2599 } 2600 2601 if( numdecimalplaces == 0 ) 2602 { 2603 dRes = floor( dVal + 0.5 ); 2604 } 2605 else 2606 { 2607 double dFactor = pow( 10.0, numdecimalplaces ); 2608 dVal *= dFactor; 2609 dRes = floor( dVal + 0.5 ); 2610 dRes /= dFactor; 2611 } 2612 2613 if( bNeg ) 2614 dRes = -dRes; 2615 } 2616 rPar.Get(0)->PutDouble( dRes ); 2617 } 2618 2619 RTLFUNC(StrReverse) 2620 { 2621 (void)pBasic; 2622 (void)bWrite; 2623 2624 if ( rPar.Count() != 2 ) 2625 { 2626 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2627 return; 2628 } 2629 2630 SbxVariable *pSbxVariable = rPar.Get(1); 2631 if( pSbxVariable->IsNull() ) 2632 { 2633 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2634 return; 2635 } 2636 2637 String aStr = pSbxVariable->GetString(); 2638 aStr.Reverse(); 2639 rPar.Get(0)->PutString( aStr ); 2640 } 2641 2642 RTLFUNC(CompatibilityMode) 2643 { 2644 (void)pBasic; 2645 (void)bWrite; 2646 2647 bool bEnabled = false; 2648 sal_uInt16 nCount = rPar.Count(); 2649 if ( nCount != 1 && nCount != 2 ) 2650 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2651 2652 SbiInstance* pInst = pINST; 2653 if( pInst ) 2654 { 2655 if ( nCount == 2 ) 2656 pInst->EnableCompatibility( rPar.Get(1)->GetBool() ); 2657 2658 bEnabled = pInst->IsCompatibility(); 2659 } 2660 rPar.Get(0)->PutBool( bEnabled ); 2661 } 2662 2663 RTLFUNC(Input) 2664 { 2665 (void)pBasic; 2666 (void)bWrite; 2667 2668 // 2 parameters needed 2669 if ( rPar.Count() < 3 ) 2670 { 2671 StarBASIC::Error( SbERR_BAD_ARGUMENT ); 2672 return; 2673 } 2674 2675 sal_uInt16 nByteCount = rPar.Get(1)->GetUShort(); 2676 sal_Int16 nFileNumber = rPar.Get(2)->GetInteger(); 2677 2678 SbiIoSystem* pIosys = pINST->GetIoSystem(); 2679 SbiStream* pSbStrm = pIosys->GetStream( nFileNumber ); 2680 if ( !pSbStrm || !(pSbStrm->GetMode() & (SBSTRM_BINARY | SBSTRM_INPUT)) ) 2681 { 2682 StarBASIC::Error( SbERR_BAD_CHANNEL ); 2683 return; 2684 } 2685 2686 ByteString aByteBuffer; 2687 SbError err = pSbStrm->Read( aByteBuffer, nByteCount, true ); 2688 if( !err ) 2689 err = pIosys->GetError(); 2690 2691 if( err ) 2692 { 2693 StarBASIC::Error( err ); 2694 return; 2695 } 2696 rPar.Get(0)->PutString( String( aByteBuffer, gsl_getSystemTextEncoding() ) ); 2697 } 2698 2699 // #115824 2700 RTLFUNC(Me) 2701 { 2702 (void)pBasic; 2703 (void)bWrite; 2704 2705 SbModule* pActiveModule = pINST->GetActiveModule(); 2706 SbClassModuleObject* pClassModuleObject = PTR_CAST(SbClassModuleObject,pActiveModule); 2707 SbxVariableRef refVar = rPar.Get(0); 2708 if( pClassModuleObject == NULL ) 2709 { 2710 SbObjModule* pMod = PTR_CAST(SbObjModule,pActiveModule); 2711 if ( pMod ) 2712 refVar->PutObject( pMod ); 2713 else 2714 StarBASIC::Error( SbERR_INVALID_USAGE_OBJECT ); 2715 } 2716 else 2717 refVar->PutObject( pClassModuleObject ); 2718 } 2719