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