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