xref: /aoo42x/main/basic/source/runtime/methods1.cxx (revision cd7fd921)
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