nss: upgrade to release 3.73
[LibreOffice.git] / basic / source / runtime / methods.cxx
blobebd48c9cc473c25cb72554b6dee9cdf08939a938
1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 /*
3 * This file is part of the LibreOffice project.
5 * This Source Code Form is subject to the terms of the Mozilla Public
6 * License, v. 2.0. If a copy of the MPL was not distributed with this
7 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 * This file incorporates work covered by the following license notice:
11 * Licensed to the Apache Software Foundation (ASF) under one or more
12 * contributor license agreements. See the NOTICE file distributed
13 * with this work for additional information regarding copyright
14 * ownership. The ASF licenses this file to you under the Apache
15 * License, Version 2.0 (the "License"); you may not use this file
16 * except in compliance with the License. You may obtain a copy of
17 * the License at http://www.apache.org/licenses/LICENSE-2.0 .
20 #include <config_features.h>
22 #include <tools/date.hxx>
23 #include <basic/sbxvar.hxx>
24 #include <basic/sbuno.hxx>
25 #include <osl/process.h>
26 #include <vcl/dibtools.hxx>
27 #include <vcl/window.hxx>
28 #include <vcl/svapp.hxx>
29 #include <vcl/settings.hxx>
30 #include <vcl/sound.hxx>
31 #include <tools/wintypes.hxx>
32 #include <vcl/stdtext.hxx>
33 #include <vcl/weld.hxx>
34 #include <basic/sbx.hxx>
35 #include <svl/zforlist.hxx>
36 #include <rtl/character.hxx>
37 #include <rtl/math.hxx>
38 #include <tools/urlobj.hxx>
39 #include <osl/time.h>
40 #include <unotools/charclass.hxx>
41 #include <unotools/ucbstreamhelper.hxx>
42 #include <tools/wldcrd.hxx>
43 #include <i18nlangtag/lang.h>
44 #include <rtl/string.hxx>
45 #include <sal/log.hxx>
46 #include <comphelper/DirectoryHelper.hxx>
48 #include <runtime.hxx>
49 #include <sbunoobj.hxx>
50 #include <osl/file.hxx>
51 #include <errobject.hxx>
53 #include <comphelper/string.hxx>
54 #include <comphelper/processfactory.hxx>
56 #include <com/sun/star/uno/Sequence.hxx>
57 #include <com/sun/star/util/DateTime.hpp>
58 #include <com/sun/star/lang/Locale.hpp>
59 #include <com/sun/star/lang/XServiceInfo.hpp>
60 #include <com/sun/star/ucb/SimpleFileAccess.hpp>
61 #include <com/sun/star/script/XErrorQuery.hpp>
62 #include <ooo/vba/VbTriState.hpp>
63 #include <com/sun/star/bridge/oleautomation/XAutomationObject.hpp>
64 #include <memory>
65 #include <random>
66 #include <o3tl/char16_t2wchar_t.hxx>
68 using namespace comphelper;
69 using namespace osl;
70 using namespace com::sun::star;
71 using namespace com::sun::star::lang;
72 using namespace com::sun::star::uno;
74 #include <date.hxx>
75 #include <sbstdobj.hxx>
76 #include <rtlproto.hxx>
77 #include <image.hxx>
78 #include <iosys.hxx>
79 #include "ddectrl.hxx"
80 #include <sbintern.hxx>
81 #include <basic/vbahelper.hxx>
83 #include <vector>
84 #include <math.h>
85 #include <stdio.h>
86 #include <stdlib.h>
87 #include <errno.h>
89 #include <sbobjmod.hxx>
90 #include <sbxmod.hxx>
92 #ifdef _WIN32
93 #include <prewin.h>
94 #include <direct.h>
95 #include <io.h>
96 #include <postwin.h>
97 #else
98 #include <unistd.h>
99 #endif
101 #include <com/sun/star/i18n/XCharacterClassification.hpp>
102 #include <vcl/unohelp.hxx>
104 #if HAVE_FEATURE_SCRIPTING
106 static void FilterWhiteSpace( OUString& rStr )
108 if (rStr.isEmpty())
110 return;
112 OUStringBuffer aRet;
114 for (sal_Int32 i = 0; i < rStr.getLength(); ++i)
116 sal_Unicode cChar = rStr[i];
117 if ((cChar != ' ') && (cChar != '\t') &&
118 (cChar != '\n') && (cChar != '\r'))
120 aRet.append(cChar);
124 rStr = aRet.makeStringAndClear();
127 static tools::Long GetDayDiff( const Date& rDate );
129 static const CharClass& GetCharClass()
131 static CharClass aCharClass( Application::GetSettings().GetLanguageTag() );
132 return aCharClass;
135 static bool isFolder( FileStatus::Type aType )
137 return ( aType == FileStatus::Directory || aType == FileStatus::Volume );
141 //*** UCB file access ***
143 // Converts possibly relative paths to absolute paths
144 // according to the setting done by ChDir/ChDrive
145 OUString getFullPath( const OUString& aRelPath )
147 OUString aFileURL;
149 // #80204 Try first if it already is a valid URL
150 INetURLObject aURLObj( aRelPath );
151 aFileURL = aURLObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
153 if( aFileURL.isEmpty() )
155 File::getFileURLFromSystemPath( aRelPath, aFileURL );
158 return aFileURL;
161 // TODO: -> SbiGlobals
162 static uno::Reference< ucb::XSimpleFileAccess3 > const & getFileAccess()
164 static uno::Reference< ucb::XSimpleFileAccess3 > xSFI = ucb::SimpleFileAccess::create( comphelper::getProcessComponentContext() );
165 return xSFI;
169 // Properties and methods lie down the return value at the Get (bPut = sal_False) in the
170 // element 0 of the Argv; the value of element 0 is saved at Put (bPut = sal_True)
172 // CreateObject( class )
174 void SbRtl_CreateObject(StarBASIC * pBasic, SbxArray & rPar, bool)
176 OUString aClass( rPar.Get32(1)->GetOUString() );
177 SbxObjectRef p = SbxBase::CreateObject( aClass );
178 if( !p.is() )
179 StarBASIC::Error( ERRCODE_BASIC_CANNOT_LOAD );
180 else
182 // Convenience: enter BASIC as parent
183 p->SetParent( pBasic );
184 rPar.Get32(0)->PutObject( p.get() );
188 // Error( n )
190 void SbRtl_Error(StarBASIC * pBasic, SbxArray & rPar, bool)
192 if( !pBasic )
193 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
194 else
196 OUString aErrorMsg;
197 ErrCode nErr = ERRCODE_NONE;
198 sal_Int32 nCode = 0;
199 if( rPar.Count32() == 1 )
201 nErr = StarBASIC::GetErrBasic();
202 aErrorMsg = StarBASIC::GetErrorMsg();
204 else
206 nCode = rPar.Get32(1)->GetLong();
207 if( nCode > 65535 )
209 StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
211 else
213 nErr = StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(nCode) );
217 bool bVBA = SbiRuntime::isVBAEnabled();
218 OUString tmpErrMsg;
219 if( bVBA && !aErrorMsg.isEmpty())
221 tmpErrMsg = aErrorMsg;
223 else
225 StarBASIC::MakeErrorText( nErr, aErrorMsg );
226 tmpErrMsg = StarBASIC::GetErrorText();
228 // If this rtlfunc 'Error' passed an errcode the same as the active Err Objects's
229 // current err then return the description for the error message if it is set
230 // ( complicated isn't it ? )
231 if ( bVBA && rPar.Count32() > 1 )
233 uno::Reference< ooo::vba::XErrObject > xErrObj( SbxErrObject::getUnoErrObject() );
234 if ( xErrObj.is() && xErrObj->getNumber() == nCode && !xErrObj->getDescription().isEmpty() )
236 tmpErrMsg = xErrObj->getDescription();
239 rPar.Get32(0)->PutString( tmpErrMsg );
243 // Sinus
245 void SbRtl_Sin(StarBASIC *, SbxArray & rPar, bool)
247 if ( rPar.Count32() < 2 )
248 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
249 else
251 SbxVariableRef pArg = rPar.Get32(1);
252 rPar.Get32(0)->PutDouble( sin( pArg->GetDouble() ) );
257 void SbRtl_Cos(StarBASIC *, SbxArray & rPar, bool)
259 if ( rPar.Count32() < 2 )
260 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
261 else
263 SbxVariableRef pArg = rPar.Get32(1);
264 rPar.Get32(0)->PutDouble( cos( pArg->GetDouble() ) );
269 void SbRtl_Atn(StarBASIC *, SbxArray & rPar, bool)
271 if ( rPar.Count32() < 2 )
272 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
273 else
275 SbxVariableRef pArg = rPar.Get32(1);
276 rPar.Get32(0)->PutDouble( atan( pArg->GetDouble() ) );
281 void SbRtl_Abs(StarBASIC *, SbxArray & rPar, bool)
283 if ( rPar.Count32() < 2 )
285 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
287 else
289 SbxVariableRef pArg = rPar.Get32(1);
290 rPar.Get32(0)->PutDouble( fabs( pArg->GetDouble() ) );
295 void SbRtl_Asc(StarBASIC *, SbxArray & rPar, bool)
297 if ( rPar.Count32() < 2 )
299 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
301 else
303 SbxVariableRef pArg = rPar.Get32(1);
304 OUString aStr( pArg->GetOUString() );
305 if ( aStr.isEmpty())
307 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
308 rPar.Get32(0)->PutEmpty();
310 else
312 sal_Unicode aCh = aStr[0];
313 rPar.Get32(0)->PutLong( aCh );
318 static void implChr( SbxArray& rPar, bool bChrW )
320 if ( rPar.Count32() < 2 )
322 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
324 else
326 SbxVariableRef pArg = rPar.Get32(1);
328 OUString aStr;
329 if( !bChrW && SbiRuntime::isVBAEnabled() )
331 char c = static_cast<char>(pArg->GetByte());
332 aStr = OUString(&c, 1, osl_getThreadTextEncoding());
334 else
336 // Map negative 16-bit values to large positive ones, so that code like Chr(&H8000)
337 // still works after the fix for tdf#62326 changed those four-digit hex notations to
338 // produce negative values:
339 sal_Int32 aCh = pArg->GetLong();
340 if (aCh < -0x8000 || aCh > 0xFFFF) {
341 StarBASIC::Error(ERRCODE_BASIC_MATH_OVERFLOW);
342 aCh = 0;
344 aStr = OUString(static_cast<sal_Unicode>(aCh));
346 rPar.Get32(0)->PutString( aStr );
350 void SbRtl_Chr(StarBASIC *, SbxArray & rPar, bool)
352 implChr( rPar, false/*bChrW*/ );
355 void SbRtl_ChrW(StarBASIC *, SbxArray & rPar, bool)
357 implChr( rPar, true/*bChrW*/ );
360 #if defined _WIN32
362 namespace {
364 extern "C" void invalidParameterHandler(
365 wchar_t const * expression, wchar_t const * function, wchar_t const * file, unsigned int line,
366 uintptr_t)
368 SAL_INFO(
369 "basic",
370 "invalid parameter during _wgetdcwd; \""
371 << (expression ? OUString(o3tl::toU(expression)) : OUString("???"))
372 << "\" (" << (function ? OUString(o3tl::toU(function)) : OUString("???")) << ") at "
373 << (file ? OUString(o3tl::toU(file)) : OUString("???")) << ":" << line);
378 #endif
380 void SbRtl_CurDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
382 (void)pBasic;
383 (void)bWrite;
385 // #57064 Although this function doesn't work with DirEntry, it isn't touched
386 // by the adjustment to virtual URLs, as, using the DirEntry-functionality,
387 // there's no possibility to detect the current one in a way that a virtual URL
388 // could be delivered.
390 #if defined(_WIN32)
391 int nCurDir = 0; // Current dir // JSM
392 if ( rPar.Count32() == 2 )
394 OUString aDrive = rPar.Get32(1)->GetOUString();
395 if ( aDrive.getLength() != 1 )
397 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
398 return;
400 auto c = rtl::toAsciiUpperCase(aDrive[0]);
401 if ( !rtl::isAsciiUpperCase( c ) )
403 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
404 return;
406 nCurDir = c - 'A' + 1;
408 wchar_t pBuffer[ _MAX_PATH ];
409 // _wgetdcwd calls the C runtime's invalid parameter handler (which by default terminates the
410 // process) if nCurDir does not correspond to an existing drive, so temporarily set a "harmless"
411 // handler:
412 auto const handler = _set_thread_local_invalid_parameter_handler(&invalidParameterHandler);
413 auto const ok = _wgetdcwd( nCurDir, pBuffer, _MAX_PATH ) != nullptr;
414 _set_thread_local_invalid_parameter_handler(handler);
415 if ( ok )
417 rPar.Get32(0)->PutString( OUString(o3tl::toU(pBuffer)) );
419 else
421 StarBASIC::Error( ERRCODE_BASIC_NO_DEVICE );
424 #else
426 const int PATH_INCR = 250;
428 int nSize = PATH_INCR;
429 std::unique_ptr<char[]> pMem;
430 while( true )
432 pMem.reset(new char[nSize]);
433 if( !pMem )
435 StarBASIC::Error( ERRCODE_BASIC_NO_MEMORY );
436 return;
438 if( getcwd( pMem.get(), nSize-1 ) != nullptr )
440 rPar.Get32(0)->PutString( OUString::createFromAscii(pMem.get()) );
441 return;
443 if( errno != ERANGE )
445 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
446 return;
448 nSize += PATH_INCR;
451 #endif
454 void SbRtl_ChDir(StarBASIC * pBasic, SbxArray & rPar, bool)
456 rPar.Get32(0)->PutEmpty();
457 if (rPar.Count32() == 2)
459 // VBA: track current directory per document type (separately for Writer, Calc, Impress, etc.)
460 if( SbiRuntime::isVBAEnabled() )
462 ::basic::vba::registerCurrentDirectory( getDocumentModel( pBasic ), rPar.Get32(1)->GetOUString() );
465 else
467 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
471 void SbRtl_ChDrive(StarBASIC *, SbxArray & rPar, bool)
473 rPar.Get32(0)->PutEmpty();
474 if (rPar.Count32() != 2)
476 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
481 // Implementation of StepRENAME with UCB
482 void implStepRenameUCB( const OUString& aSource, const OUString& aDest )
484 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
485 if( !xSFI.is() )
486 return;
490 OUString aSourceFullPath = getFullPath( aSource );
491 if( !xSFI->exists( aSourceFullPath ) )
493 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
494 return;
497 OUString aDestFullPath = getFullPath( aDest );
498 if( xSFI->exists( aDestFullPath ) )
500 StarBASIC::Error( ERRCODE_BASIC_FILE_EXISTS );
502 else
504 xSFI->move( aSourceFullPath, aDestFullPath );
507 catch(const Exception & )
509 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
513 // Implementation of StepRENAME with OSL
514 void implStepRenameOSL( const OUString& aSource, const OUString& aDest )
516 FileBase::RC nRet = File::move( getFullPath( aSource ), getFullPath( aDest ) );
517 if( nRet != FileBase::E_None )
519 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
523 void SbRtl_FileCopy(StarBASIC *, SbxArray & rPar, bool)
525 rPar.Get32(0)->PutEmpty();
526 if (rPar.Count32() == 3)
528 OUString aSource = rPar.Get32(1)->GetOUString();
529 OUString aDest = rPar.Get32(2)->GetOUString();
530 if( hasUno() )
532 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
533 if( xSFI.is() )
537 xSFI->copy( getFullPath( aSource ), getFullPath( aDest ) );
539 catch(const Exception & )
541 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
545 else
547 FileBase::RC nRet = File::copy( getFullPath( aSource ), getFullPath( aDest ) );
548 if( nRet != FileBase::E_None )
550 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
554 else
555 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
558 void SbRtl_Kill(StarBASIC *, SbxArray & rPar, bool)
560 rPar.Get32(0)->PutEmpty();
561 if (rPar.Count32() == 2)
563 OUString aFileSpec = rPar.Get32(1)->GetOUString();
565 if( hasUno() )
567 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
568 if( xSFI.is() )
570 OUString aFullPath = getFullPath( aFileSpec );
571 if( !xSFI->exists( aFullPath ) || xSFI->isFolder( aFullPath ) )
573 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
574 return;
578 xSFI->kill( aFullPath );
580 catch(const Exception & )
582 StarBASIC::Error( ERRCODE_IO_GENERAL );
586 else
588 File::remove( getFullPath( aFileSpec ) );
591 else
593 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
597 void SbRtl_MkDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
599 rPar.Get32(0)->PutEmpty();
600 if (rPar.Count32() == 2)
602 OUString aPath = rPar.Get32(1)->GetOUString();
603 if ( SbiRuntime::isVBAEnabled() )
605 // In vba if the full path is not specified then
606 // folder is created relative to the curdir
607 INetURLObject aURLObj( getFullPath( aPath ) );
608 if ( aURLObj.GetProtocol() != INetProtocol::File )
610 SbxArrayRef pPar = new SbxArray();
611 SbxVariableRef pResult = new SbxVariable();
612 SbxVariableRef pParam = new SbxVariable();
613 pPar->Insert32( pResult.get(), pPar->Count32() );
614 pPar->Insert32( pParam.get(), pPar->Count32() );
615 SbRtl_CurDir( pBasic, *pPar, bWrite );
617 OUString sCurPathURL;
618 File::getFileURLFromSystemPath( pPar->Get32(0)->GetOUString(), sCurPathURL );
620 aURLObj.SetURL( sCurPathURL );
621 aURLObj.Append( aPath );
622 File::getSystemPathFromFileURL(aURLObj.GetMainURL( INetURLObject::DecodeMechanism::ToIUri ),aPath ) ;
626 if( hasUno() )
628 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
629 if( xSFI.is() )
633 xSFI->createFolder( getFullPath( aPath ) );
635 catch(const Exception & )
637 StarBASIC::Error( ERRCODE_IO_GENERAL );
641 else
643 Directory::create( getFullPath( aPath ) );
646 else
648 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
653 static void implRemoveDirRecursive( const OUString& aDirPath )
655 DirectoryItem aItem;
656 FileBase::RC nRet = DirectoryItem::get( aDirPath, aItem );
657 bool bExists = (nRet == FileBase::E_None);
659 FileStatus aFileStatus( osl_FileStatus_Mask_Type );
660 nRet = aItem.getFileStatus( aFileStatus );
661 bool bFolder = nRet == FileBase::E_None
662 && isFolder( aFileStatus.getFileType() );
664 if( !bExists || !bFolder )
666 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
667 return;
670 Directory aDir( aDirPath );
671 nRet = aDir.open();
672 if( nRet != FileBase::E_None )
674 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
675 return;
677 aDir.close();
679 comphelper::DirectoryHelper::deleteDirRecursively(aDirPath);
683 void SbRtl_RmDir(StarBASIC *, SbxArray & rPar, bool)
685 rPar.Get32(0)->PutEmpty();
686 if (rPar.Count32() == 2)
688 OUString aPath = rPar.Get32(1)->GetOUString();
689 if( hasUno() )
691 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
692 if( xSFI.is() )
696 if( !xSFI->isFolder( aPath ) )
698 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
699 return;
701 SbiInstance* pInst = GetSbData()->pInst;
702 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
703 if( bCompatibility )
705 Sequence< OUString > aContent = xSFI->getFolderContents( aPath, true );
706 if( aContent.hasElements() )
708 StarBASIC::Error( ERRCODE_BASIC_ACCESS_ERROR );
709 return;
713 xSFI->kill( getFullPath( aPath ) );
715 catch(const Exception & )
717 StarBASIC::Error( ERRCODE_IO_GENERAL );
721 else
723 implRemoveDirRecursive( getFullPath( aPath ) );
726 else
728 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
732 void SbRtl_SendKeys(StarBASIC *, SbxArray & rPar, bool)
734 rPar.Get32(0)->PutEmpty();
735 StarBASIC::Error(ERRCODE_BASIC_NOT_IMPLEMENTED);
738 void SbRtl_Exp(StarBASIC *, SbxArray & rPar, bool)
740 if( rPar.Count32() < 2 )
741 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
742 else
744 double aDouble = rPar.Get32(1)->GetDouble();
745 aDouble = exp( aDouble );
746 checkArithmeticOverflow( aDouble );
747 rPar.Get32(0)->PutDouble( aDouble );
751 void SbRtl_FileLen(StarBASIC *, SbxArray & rPar, bool)
753 if ( rPar.Count32() < 2 )
755 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
757 else
759 SbxVariableRef pArg = rPar.Get32(1);
760 OUString aStr( pArg->GetOUString() );
761 sal_Int32 nLen = 0;
762 if( hasUno() )
764 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
765 if( xSFI.is() )
769 nLen = xSFI->getSize( getFullPath( aStr ) );
771 catch(const Exception & )
773 StarBASIC::Error( ERRCODE_IO_GENERAL );
777 else
779 DirectoryItem aItem;
780 (void)DirectoryItem::get( getFullPath( aStr ), aItem );
781 FileStatus aFileStatus( osl_FileStatus_Mask_FileSize );
782 (void)aItem.getFileStatus( aFileStatus );
783 nLen = static_cast<sal_Int32>(aFileStatus.getFileSize());
785 rPar.Get32(0)->PutLong( static_cast<tools::Long>(nLen) );
790 void SbRtl_Hex(StarBASIC *, SbxArray & rPar, bool)
792 if ( rPar.Count32() < 2 )
794 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
796 else
798 SbxVariableRef pArg = rPar.Get32(1);
799 // converting value to unsigned and limit to 2 or 4 byte representation
800 sal_uInt32 nVal = pArg->IsInteger() ?
801 static_cast<sal_uInt16>(pArg->GetInteger()) :
802 static_cast<sal_uInt32>(pArg->GetLong());
803 OUString aStr(OUString::number( nVal, 16 ));
804 aStr = aStr.toAsciiUpperCase();
805 rPar.Get32(0)->PutString( aStr );
809 void SbRtl_FuncCaller(StarBASIC *, SbxArray & rPar, bool)
811 if ( SbiRuntime::isVBAEnabled() && GetSbData()->pInst && GetSbData()->pInst->pRun )
813 if ( GetSbData()->pInst->pRun->GetExternalCaller() )
814 *rPar.Get32(0) = *GetSbData()->pInst->pRun->GetExternalCaller();
815 else
817 SbxVariableRef pVar = new SbxVariable(SbxVARIANT);
818 *rPar.Get32(0) = *pVar;
821 else
823 StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED );
827 // InStr( [start],string,string,[compare] )
829 void SbRtl_InStr(StarBASIC *, SbxArray & rPar, bool)
831 const sal_uInt32 nArgCount = rPar.Count32()-1;
832 if ( nArgCount < 2 )
833 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
834 else
836 sal_Int32 nStartPos = 1;
837 sal_Int32 nFirstStringPos = 1;
839 if ( nArgCount >= 3 )
841 nStartPos = rPar.Get32(1)->GetLong();
842 if( nStartPos <= 0 )
844 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
845 nStartPos = 1;
847 nFirstStringPos++;
850 SbiInstance* pInst = GetSbData()->pInst;
851 bool bTextMode;
852 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
853 if( bCompatibility )
855 SbiRuntime* pRT = pInst->pRun;
856 bTextMode = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
858 else
860 bTextMode = true;
862 if ( nArgCount == 4 )
864 bTextMode = rPar.Get32(4)->GetInteger();
866 sal_Int32 nPos;
867 const OUString& rToken = rPar.Get32(nFirstStringPos+1)->GetOUString();
869 // #97545 Always find empty string
870 if( rToken.isEmpty() )
872 nPos = nStartPos;
874 else
876 if( !bTextMode )
878 const OUString& rStr1 = rPar.Get32(nFirstStringPos)->GetOUString();
879 nPos = rStr1.indexOf( rToken, nStartPos - 1 ) + 1;
881 else
883 OUString aStr1 = rPar.Get32(nFirstStringPos)->GetOUString();
884 OUString aToken = rToken;
886 aStr1 = aStr1.toAsciiUpperCase();
887 aToken = aToken.toAsciiUpperCase();
889 nPos = aStr1.indexOf( aToken, nStartPos-1 ) + 1;
892 rPar.Get32(0)->PutLong( nPos );
897 // InstrRev(string1, string2[, start[, compare]])
899 void SbRtl_InStrRev(StarBASIC *, SbxArray & rPar, bool)
901 const sal_uInt32 nArgCount = rPar.Count32()-1;
902 if ( nArgCount < 2 )
904 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
906 else
908 OUString aStr1 = rPar.Get32(1)->GetOUString();
909 OUString aToken = rPar.Get32(2)->GetOUString();
911 sal_Int32 nStartPos = -1;
912 if ( nArgCount >= 3 )
914 nStartPos = rPar.Get32(3)->GetLong();
915 if( nStartPos <= 0 && nStartPos != -1 )
917 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
918 nStartPos = -1;
922 SbiInstance* pInst = GetSbData()->pInst;
923 bool bTextMode;
924 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
925 if( bCompatibility )
927 SbiRuntime* pRT = pInst->pRun;
928 bTextMode = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
930 else
932 bTextMode = true;
934 if ( nArgCount == 4 )
936 bTextMode = rPar.Get32(4)->GetInteger();
938 sal_Int32 nStrLen = aStr1.getLength();
939 if( nStartPos == -1 )
941 nStartPos = nStrLen;
944 sal_Int32 nPos = 0;
945 if( nStartPos <= nStrLen )
947 sal_Int32 nTokenLen = aToken.getLength();
948 if( !nTokenLen )
950 // Always find empty string
951 nPos = nStartPos;
953 else if( nStrLen > 0 )
955 if( !bTextMode )
957 nPos = aStr1.lastIndexOf( aToken, nStartPos ) + 1;
959 else
961 aStr1 = aStr1.toAsciiUpperCase();
962 aToken = aToken.toAsciiUpperCase();
964 nPos = aStr1.lastIndexOf( aToken, nStartPos ) + 1;
968 rPar.Get32(0)->PutLong( nPos );
974 Int( 2.8 ) = 2.0
975 Int( -2.8 ) = -3.0
976 Fix( 2.8 ) = 2.0
977 Fix( -2.8 ) = -2.0 <- !!
980 void SbRtl_Int(StarBASIC *, SbxArray & rPar, bool)
982 if ( rPar.Count32() < 2 )
983 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
984 else
986 SbxVariableRef pArg = rPar.Get32(1);
987 double aDouble= pArg->GetDouble();
989 floor( 2.8 ) = 2.0
990 floor( -2.8 ) = -3.0
992 aDouble = floor( aDouble );
993 rPar.Get32(0)->PutDouble( aDouble );
998 void SbRtl_Fix(StarBASIC *, SbxArray & rPar, bool)
1000 if ( rPar.Count32() < 2 )
1001 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1002 else
1004 SbxVariableRef pArg = rPar.Get32(1);
1005 double aDouble = pArg->GetDouble();
1006 if ( aDouble >= 0.0 )
1007 aDouble = floor( aDouble );
1008 else
1009 aDouble = ceil( aDouble );
1010 rPar.Get32(0)->PutDouble( aDouble );
1015 void SbRtl_LCase(StarBASIC *, SbxArray & rPar, bool)
1017 if ( rPar.Count32() < 2 )
1019 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1021 else
1023 const CharClass& rCharClass = GetCharClass();
1024 OUString aStr( rPar.Get32(1)->GetOUString() );
1025 aStr = rCharClass.lowercase(aStr);
1026 rPar.Get32(0)->PutString( aStr );
1030 void SbRtl_Left(StarBASIC *, SbxArray & rPar, bool)
1032 if ( rPar.Count32() < 3 )
1034 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1036 else
1038 OUString aStr( rPar.Get32(1)->GetOUString() );
1039 sal_Int32 nResultLen = rPar.Get32(2)->GetLong();
1040 if( nResultLen < 0 )
1042 nResultLen = 0;
1043 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1045 else if(nResultLen > aStr.getLength())
1047 nResultLen = aStr.getLength();
1049 aStr = aStr.copy(0, nResultLen );
1050 rPar.Get32(0)->PutString( aStr );
1054 void SbRtl_Log(StarBASIC *, SbxArray & rPar, bool)
1056 if ( rPar.Count32() < 2 )
1058 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1060 else
1062 double aArg = rPar.Get32(1)->GetDouble();
1063 if ( aArg > 0 )
1065 double d = log( aArg );
1066 checkArithmeticOverflow( d );
1067 rPar.Get32(0)->PutDouble( d );
1069 else
1071 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1076 void SbRtl_LTrim(StarBASIC *, SbxArray & rPar, bool)
1078 if ( rPar.Count32() < 2 )
1080 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1082 else
1084 OUString aStr(comphelper::string::stripStart(rPar.Get32(1)->GetOUString(), ' '));
1085 rPar.Get32(0)->PutString(aStr);
1090 // Mid( String, nStart, nLength )
1092 void SbRtl_Mid(StarBASIC *, SbxArray & rPar, bool bWrite)
1094 int nArgCount = rPar.Count32()-1;
1095 if ( nArgCount < 2 )
1097 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1099 else
1101 // #23178: replicate the functionality of Mid$ as a command
1102 // by adding a replacement-string as a fourth parameter.
1103 // In contrast to the original the third parameter (nLength)
1104 // can't be left out here. That's considered in bWrite already.
1105 if( nArgCount == 4 )
1107 bWrite = true;
1109 OUString aArgStr = rPar.Get32(1)->GetOUString();
1110 sal_Int32 nStartPos = rPar.Get32(2)->GetLong();
1111 if ( nStartPos < 1 )
1113 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1115 else
1117 nStartPos--;
1118 sal_Int32 nLen = -1;
1119 bool bWriteNoLenParam = false;
1120 if ( nArgCount == 3 || bWrite )
1122 sal_Int32 n = rPar.Get32(3)->GetLong();
1123 if( bWrite && n == -1 )
1125 bWriteNoLenParam = true;
1127 nLen = n;
1129 if ( bWrite )
1131 sal_Int32 nArgLen = aArgStr.getLength();
1132 if( nStartPos > nArgLen )
1134 SbiInstance* pInst = GetSbData()->pInst;
1135 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1136 if( bCompatibility )
1138 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1139 return;
1141 nStartPos = nArgLen;
1144 OUString aReplaceStr = rPar.Get32(4)->GetOUString();
1145 sal_Int32 nReplaceStrLen = aReplaceStr.getLength();
1146 sal_Int32 nReplaceLen;
1147 if( bWriteNoLenParam )
1149 nReplaceLen = nArgLen - nStartPos;
1151 else
1153 nReplaceLen = nLen;
1154 if( nReplaceLen < 0 || nReplaceLen > nArgLen - nStartPos )
1156 nReplaceLen = nArgLen - nStartPos;
1160 OUStringBuffer aResultStr = aArgStr;
1161 sal_Int32 nErase = nReplaceLen;
1162 aResultStr.remove( nStartPos, nErase );
1163 aResultStr.insert(
1164 nStartPos, aReplaceStr.getStr(), std::min(nReplaceLen, nReplaceStrLen));
1166 rPar.Get32(1)->PutString( aResultStr.makeStringAndClear() );
1168 else
1170 OUString aResultStr;
1171 if (nStartPos > aArgStr.getLength())
1173 // do nothing
1175 else if(nArgCount == 2)
1177 aResultStr = aArgStr.copy( nStartPos);
1179 else
1181 if (nLen < 0)
1182 nLen = 0;
1183 if(nStartPos + nLen > aArgStr.getLength())
1185 nLen = aArgStr.getLength() - nStartPos;
1187 if (nLen > 0)
1188 aResultStr = aArgStr.copy( nStartPos, nLen );
1190 rPar.Get32(0)->PutString( aResultStr );
1196 void SbRtl_Oct(StarBASIC *, SbxArray & rPar, bool)
1198 if ( rPar.Count32() < 2 )
1200 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1202 else
1204 char aBuffer[16];
1205 SbxVariableRef pArg = rPar.Get32(1);
1206 if ( pArg->IsInteger() )
1208 snprintf( aBuffer, sizeof(aBuffer), "%o", pArg->GetInteger() );
1210 else
1212 snprintf( aBuffer, sizeof(aBuffer), "%lo", static_cast<long unsigned int>(pArg->GetLong()) );
1214 rPar.Get32(0)->PutString( OUString::createFromAscii( aBuffer ) );
1218 // Replace(expression, find, replace[, start[, count[, compare]]])
1220 void SbRtl_Replace(StarBASIC *, SbxArray & rPar, bool)
1222 const sal_uInt32 nArgCount = rPar.Count32()-1;
1223 if ( nArgCount < 3 || nArgCount > 6 )
1225 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1226 return;
1229 sal_Int32 lStartPos = 1;
1230 if (nArgCount >= 4)
1232 if (rPar.Get32(4)->GetType() != SbxEMPTY)
1234 lStartPos = rPar.Get32(4)->GetLong();
1236 if (lStartPos < 1)
1238 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
1239 return;
1243 sal_Int32 lCount = -1;
1244 if (nArgCount >= 5)
1246 if (rPar.Get32(5)->GetType() != SbxEMPTY)
1248 lCount = rPar.Get32(5)->GetLong();
1250 if (lCount < -1)
1252 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
1253 return;
1257 bool bCaseInsensitive;
1258 if (nArgCount == 6)
1260 bCaseInsensitive = rPar.Get32(6)->GetInteger();
1262 else
1264 SbiInstance* pInst = GetSbData()->pInst;
1265 if (pInst && pInst->IsCompatibility())
1267 SbiRuntime* pRT = pInst->pRun;
1268 bCaseInsensitive = pRT && pRT->IsImageFlag(SbiImageFlags::COMPARETEXT);
1270 else
1272 bCaseInsensitive = true;
1276 const OUString aExpStr = rPar.Get32(1)->GetOUString();
1277 OUString aFindStr = rPar.Get32(2)->GetOUString();
1278 const OUString aReplaceStr = rPar.Get32(3)->GetOUString();
1280 OUString aSrcStr(aExpStr);
1281 if (bCaseInsensitive)
1283 // tdf#132389 - case-insensitive operation for non-ASCII characters
1284 const css::lang::Locale& rLocale = Application::GetSettings().GetUILanguageTag().getLocale();
1285 css::uno::Reference < i18n::XCharacterClassification > xCharClass = vcl::unohelper::CreateCharacterClassification();
1286 aSrcStr = xCharClass->toUpper(aSrcStr, 0, aSrcStr.getLength(), rLocale);
1287 aFindStr = xCharClass->toUpper(aFindStr, 0, aFindStr.getLength(), rLocale);
1289 const sal_Int32 nSrcStrLen = aSrcStr.getLength();
1290 const sal_Int32 nFindStrLen = aFindStr.getLength();
1292 // Note: the result starts from lStartPos, removing everything to the left. See i#94895.
1293 sal_Int32 nPrevPos = std::min(lStartPos - 1, nSrcStrLen);
1294 OUStringBuffer sResult(nSrcStrLen - nPrevPos);
1295 sal_Int32 nCounts = 0;
1296 while (lCount == -1 || lCount > nCounts)
1298 sal_Int32 nPos = aSrcStr.indexOf(aFindStr, nPrevPos);
1299 if (nPos >= 0)
1301 sResult.append(aExpStr.getStr() + nPrevPos, nPos - nPrevPos);
1302 sResult.append(aReplaceStr);
1303 nPrevPos = nPos + nFindStrLen;
1304 nCounts++;
1306 else
1308 break;
1311 sResult.append(aExpStr.getStr() + nPrevPos, nSrcStrLen - nPrevPos);
1312 rPar.Get32(0)->PutString(sResult.makeStringAndClear());
1315 void SbRtl_Right(StarBASIC *, SbxArray & rPar, bool)
1317 if ( rPar.Count32() < 3 )
1319 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1321 else
1323 const OUString& rStr = rPar.Get32(1)->GetOUString();
1324 int nResultLen = rPar.Get32(2)->GetLong();
1325 if( nResultLen < 0 )
1327 nResultLen = 0;
1328 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1330 int nStrLen = rStr.getLength();
1331 if ( nResultLen > nStrLen )
1333 nResultLen = nStrLen;
1335 OUString aResultStr = rStr.copy( nStrLen - nResultLen );
1336 rPar.Get32(0)->PutString( aResultStr );
1340 void SbRtl_RTL(StarBASIC * pBasic, SbxArray & rPar, bool)
1342 rPar.Get32(0)->PutObject( pBasic->getRTL().get() );
1345 void SbRtl_RTrim(StarBASIC *, SbxArray & rPar, bool)
1347 if ( rPar.Count32() < 2 )
1349 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1351 else
1353 OUString aStr(comphelper::string::stripEnd(rPar.Get32(1)->GetOUString(), ' '));
1354 rPar.Get32(0)->PutString(aStr);
1358 void SbRtl_Sgn(StarBASIC *, SbxArray & rPar, bool)
1360 if ( rPar.Count32() < 2 )
1362 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1364 else
1366 double aDouble = rPar.Get32(1)->GetDouble();
1367 sal_Int16 nResult = 0;
1368 if ( aDouble > 0 )
1370 nResult = 1;
1372 else if ( aDouble < 0 )
1374 nResult = -1;
1376 rPar.Get32(0)->PutInteger( nResult );
1380 void SbRtl_Space(StarBASIC *, SbxArray & rPar, bool)
1382 if ( rPar.Count32() < 2 )
1384 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1386 else
1388 OUStringBuffer aBuf;
1389 string::padToLength(aBuf, rPar.Get32(1)->GetLong(), ' ');
1390 rPar.Get32(0)->PutString(aBuf.makeStringAndClear());
1394 void SbRtl_Spc(StarBASIC *, SbxArray & rPar, bool)
1396 if ( rPar.Count32() < 2 )
1398 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1400 else
1402 OUStringBuffer aBuf;
1403 string::padToLength(aBuf, rPar.Get32(1)->GetLong(), ' ');
1404 rPar.Get32(0)->PutString(aBuf.makeStringAndClear());
1408 void SbRtl_Sqr(StarBASIC *, SbxArray & rPar, bool)
1410 if ( rPar.Count32() < 2 )
1412 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1414 else
1416 double aDouble = rPar.Get32(1)->GetDouble();
1417 if ( aDouble >= 0 )
1419 rPar.Get32(0)->PutDouble( sqrt( aDouble ));
1421 else
1423 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1428 void SbRtl_Str(StarBASIC *, SbxArray & rPar, bool)
1430 if ( rPar.Count32() < 2 )
1432 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1434 else
1436 OUString aStr;
1437 OUString aStrNew("");
1438 SbxVariableRef pArg = rPar.Get32(1);
1439 pArg->Format( aStr );
1441 // Numbers start with a space
1442 if( pArg->IsNumericRTL() )
1444 // replace commas by points so that it's symmetric to Val!
1445 aStr = aStr.replaceFirst( ",", "." );
1447 SbiInstance* pInst = GetSbData()->pInst;
1448 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1449 if( bCompatibility )
1451 sal_Int32 nLen = aStr.getLength();
1453 const sal_Unicode* pBuf = aStr.getStr();
1455 bool bNeg = ( pBuf[0] == '-' );
1456 sal_Int32 iZeroSearch = 0;
1457 if( bNeg )
1459 aStrNew += "-";
1460 iZeroSearch++;
1462 else
1464 if( pBuf[0] != ' ' )
1466 aStrNew += " ";
1469 sal_Int32 iNext = iZeroSearch + 1;
1470 if( pBuf[iZeroSearch] == '0' && nLen > iNext && pBuf[iNext] == '.' )
1472 iZeroSearch += 1;
1474 aStrNew += aStr.subView(iZeroSearch);
1476 else
1478 aStrNew = " " + aStr;
1481 else
1483 aStrNew = aStr;
1485 rPar.Get32(0)->PutString( aStrNew );
1489 void SbRtl_StrComp(StarBASIC *, SbxArray & rPar, bool)
1491 if ( rPar.Count32() < 3 )
1493 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1494 rPar.Get32(0)->PutEmpty();
1495 return;
1497 const OUString& rStr1 = rPar.Get32(1)->GetOUString();
1498 const OUString& rStr2 = rPar.Get32(2)->GetOUString();
1500 SbiInstance* pInst = GetSbData()->pInst;
1501 bool bTextCompare;
1502 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1503 if( bCompatibility )
1505 SbiRuntime* pRT = pInst->pRun;
1506 bTextCompare = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
1508 else
1510 bTextCompare = true;
1512 if ( rPar.Count32() == 4 )
1513 bTextCompare = rPar.Get32(3)->GetInteger();
1515 if( !bCompatibility )
1517 bTextCompare = !bTextCompare;
1519 sal_Int32 nRetValue = 0;
1520 if( bTextCompare )
1522 ::utl::TransliterationWrapper* pTransliterationWrapper = GetSbData()->pTransliterationWrapper.get();
1523 if( !pTransliterationWrapper )
1525 uno::Reference< uno::XComponentContext > xContext = getProcessComponentContext();
1526 GetSbData()->pTransliterationWrapper.reset(
1527 new ::utl::TransliterationWrapper( xContext,
1528 TransliterationFlags::IGNORE_CASE |
1529 TransliterationFlags::IGNORE_KANA |
1530 TransliterationFlags::IGNORE_WIDTH ) );
1531 pTransliterationWrapper = GetSbData()->pTransliterationWrapper.get();
1534 LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
1535 pTransliterationWrapper->loadModuleIfNeeded( eLangType );
1536 nRetValue = pTransliterationWrapper->compareString( rStr1, rStr2 );
1538 else
1540 sal_Int32 aResult;
1541 aResult = rStr1.compareTo( rStr2 );
1542 if ( aResult < 0 )
1544 nRetValue = -1;
1546 else if ( aResult > 0)
1548 nRetValue = 1;
1551 rPar.Get32(0)->PutInteger( sal::static_int_cast< sal_Int16 >( nRetValue ) );
1554 void SbRtl_String(StarBASIC *, SbxArray & rPar, bool)
1556 if ( rPar.Count32() < 2 )
1558 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1560 else
1562 sal_Unicode aFiller;
1563 sal_Int32 lCount = rPar.Get32(1)->GetLong();
1564 if( lCount < 0 || lCount > 0xffff )
1566 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1568 if( rPar.Get32(2)->GetType() == SbxINTEGER )
1570 aFiller = static_cast<sal_Unicode>(rPar.Get32(2)->GetInteger());
1572 else
1574 const OUString& rStr = rPar.Get32(2)->GetOUString();
1575 aFiller = rStr[0];
1577 OUStringBuffer aBuf(lCount);
1578 string::padToLength(aBuf, lCount, aFiller);
1579 rPar.Get32(0)->PutString(aBuf.makeStringAndClear());
1583 void SbRtl_Tab(StarBASIC *, SbxArray & rPar, bool)
1585 if ( rPar.Count32() < 2 )
1586 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1587 else
1589 OUStringBuffer aStr;
1590 comphelper::string::padToLength(aStr, rPar.Get32(1)->GetLong(), '\t');
1591 rPar.Get32(0)->PutString(aStr.makeStringAndClear());
1595 void SbRtl_Tan(StarBASIC *, SbxArray & rPar, bool)
1597 if ( rPar.Count32() < 2 )
1599 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1601 else
1603 SbxVariableRef pArg = rPar.Get32(1);
1604 rPar.Get32(0)->PutDouble( tan( pArg->GetDouble() ) );
1608 void SbRtl_UCase(StarBASIC *, SbxArray & rPar, bool)
1610 if ( rPar.Count32() < 2 )
1612 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1614 else
1616 const CharClass& rCharClass = GetCharClass();
1617 OUString aStr( rPar.Get32(1)->GetOUString() );
1618 aStr = rCharClass.uppercase( aStr );
1619 rPar.Get32(0)->PutString( aStr );
1624 void SbRtl_Val(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
1626 (void)pBasic;
1627 (void)bWrite;
1629 if ( rPar.Count32() < 2 )
1631 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1633 else
1635 double nResult = 0.0;
1636 char* pEndPtr;
1638 OUString aStr( rPar.Get32(1)->GetOUString() );
1640 FilterWhiteSpace( aStr );
1641 if ( aStr.getLength() > 1 && aStr[0] == '&' )
1643 int nRadix = 10;
1644 char aChar = static_cast<char>(aStr[1]);
1645 if ( aChar == 'h' || aChar == 'H' )
1647 nRadix = 16;
1649 else if ( aChar == 'o' || aChar == 'O' )
1651 nRadix = 8;
1653 if ( nRadix != 10 )
1655 OString aByteStr(OUStringToOString(aStr, osl_getThreadTextEncoding()));
1656 sal_Int16 nlResult = static_cast<sal_Int16>(strtol( aByteStr.getStr()+2, &pEndPtr, nRadix));
1657 nResult = static_cast<double>(nlResult);
1660 else
1662 rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok;
1663 sal_Int32 nParseEnd = 0;
1664 nResult = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd );
1665 if ( eStatus != rtl_math_ConversionStatus_Ok )
1666 StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW );
1667 /* TODO: we should check whether all characters were parsed here,
1668 * but earlier code silently ignored trailing nonsense such as "1x"
1669 * resulting in 1 with the side effect that any alpha-only-string
1670 * like "x" resulted in 0. Not changing that now (2013-03-22) as
1671 * user macros may rely on it. */
1672 #if 0
1673 else if ( nParseEnd != aStr.getLength() )
1674 StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
1675 #endif
1678 rPar.Get32(0)->PutDouble( nResult );
1683 // Helper functions for date conversion
1684 sal_Int16 implGetDateDay( double aDate )
1686 aDate -= 2.0; // standardize: 1.1.1900 => 0.0
1687 aDate = floor( aDate );
1688 Date aRefDate( 1, 1, 1900 );
1689 aRefDate.AddDays( aDate );
1691 sal_Int16 nRet = static_cast<sal_Int16>( aRefDate.GetDay() );
1692 return nRet;
1695 sal_Int16 implGetDateMonth( double aDate )
1697 Date aRefDate( 1,1,1900 );
1698 sal_Int32 nDays = static_cast<sal_Int32>(aDate);
1699 nDays -= 2; // standardize: 1.1.1900 => 0.0
1700 aRefDate.AddDays( nDays );
1701 sal_Int16 nRet = static_cast<sal_Int16>( aRefDate.GetMonth() );
1702 return nRet;
1705 css::util::Date SbxDateToUNODate( const SbxValue* const pVal )
1707 double aDate = pVal->GetDate();
1709 css::util::Date aUnoDate;
1710 aUnoDate.Day = implGetDateDay ( aDate );
1711 aUnoDate.Month = implGetDateMonth( aDate );
1712 aUnoDate.Year = implGetDateYear ( aDate );
1714 return aUnoDate;
1717 void SbxDateFromUNODate( SbxValue *pVal, const css::util::Date& aUnoDate)
1719 double dDate;
1720 if( implDateSerial( aUnoDate.Year, aUnoDate.Month, aUnoDate.Day, false, SbDateCorrection::None, dDate ) )
1722 pVal->PutDate( dDate );
1726 // Function to convert date to UNO date (com.sun.star.util.Date)
1727 void SbRtl_CDateToUnoDate(StarBASIC *, SbxArray & rPar, bool)
1729 if ( rPar.Count32() != 2 )
1731 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1732 return;
1735 unoToSbxValue(rPar.Get32(0), Any(SbxDateToUNODate(rPar.Get32(1))));
1738 // Function to convert date from UNO date (com.sun.star.util.Date)
1739 void SbRtl_CDateFromUnoDate(StarBASIC *, SbxArray & rPar, bool)
1741 if ( rPar.Count32() != 2 || rPar.Get32(1)->GetType() != SbxOBJECT )
1743 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1744 return;
1747 Any aAny (sbxToUnoValue(rPar.Get32(1), cppu::UnoType<css::util::Date>::get()));
1748 css::util::Date aUnoDate;
1749 if(aAny >>= aUnoDate)
1750 SbxDateFromUNODate(rPar.Get32(0), aUnoDate);
1751 else
1752 SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
1755 css::util::Time SbxDateToUNOTime( const SbxValue* const pVal )
1757 double aDate = pVal->GetDate();
1759 css::util::Time aUnoTime;
1760 aUnoTime.Hours = implGetHour ( aDate );
1761 aUnoTime.Minutes = implGetMinute ( aDate );
1762 aUnoTime.Seconds = implGetSecond ( aDate );
1763 aUnoTime.NanoSeconds = 0;
1765 return aUnoTime;
1768 void SbxDateFromUNOTime( SbxValue *pVal, const css::util::Time& aUnoTime)
1770 pVal->PutDate( implTimeSerial(aUnoTime.Hours, aUnoTime.Minutes, aUnoTime.Seconds) );
1773 // Function to convert date to UNO time (com.sun.star.util.Time)
1774 void SbRtl_CDateToUnoTime(StarBASIC *, SbxArray & rPar, bool)
1776 if ( rPar.Count32() != 2 )
1778 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1779 return;
1782 unoToSbxValue(rPar.Get32(0), Any(SbxDateToUNOTime(rPar.Get32(1))));
1785 // Function to convert date from UNO time (com.sun.star.util.Time)
1786 void SbRtl_CDateFromUnoTime(StarBASIC *, SbxArray & rPar, bool)
1788 if ( rPar.Count32() != 2 || rPar.Get32(1)->GetType() != SbxOBJECT )
1790 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1791 return;
1794 Any aAny (sbxToUnoValue(rPar.Get32(1), cppu::UnoType<css::util::Time>::get()));
1795 css::util::Time aUnoTime;
1796 if(aAny >>= aUnoTime)
1797 SbxDateFromUNOTime(rPar.Get32(0), aUnoTime);
1798 else
1799 SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
1802 css::util::DateTime SbxDateToUNODateTime( const SbxValue* const pVal )
1804 double aDate = pVal->GetDate();
1806 css::util::DateTime aUnoDT;
1807 aUnoDT.Day = implGetDateDay ( aDate );
1808 aUnoDT.Month = implGetDateMonth( aDate );
1809 aUnoDT.Year = implGetDateYear ( aDate );
1810 aUnoDT.Hours = implGetHour ( aDate );
1811 aUnoDT.Minutes = implGetMinute ( aDate );
1812 aUnoDT.Seconds = implGetSecond ( aDate );
1813 aUnoDT.NanoSeconds = 0;
1815 return aUnoDT;
1818 void SbxDateFromUNODateTime( SbxValue *pVal, const css::util::DateTime& aUnoDT)
1820 double dDate(0.0);
1821 if( implDateTimeSerial( aUnoDT.Year, aUnoDT.Month, aUnoDT.Day,
1822 aUnoDT.Hours, aUnoDT.Minutes, aUnoDT.Seconds,
1823 dDate ) )
1825 pVal->PutDate( dDate );
1829 // Function to convert date to UNO date (com.sun.star.util.Date)
1830 void SbRtl_CDateToUnoDateTime(StarBASIC *, SbxArray & rPar, bool)
1832 if ( rPar.Count32() != 2 )
1834 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1835 return;
1838 unoToSbxValue(rPar.Get32(0), Any(SbxDateToUNODateTime(rPar.Get32(1))));
1841 // Function to convert date from UNO date (com.sun.star.util.Date)
1842 void SbRtl_CDateFromUnoDateTime(StarBASIC *, SbxArray & rPar, bool)
1844 if ( rPar.Count32() != 2 || rPar.Get32(1)->GetType() != SbxOBJECT )
1846 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1847 return;
1850 Any aAny (sbxToUnoValue(rPar.Get32(1), cppu::UnoType<css::util::DateTime>::get()));
1851 css::util::DateTime aUnoDT;
1852 if(aAny >>= aUnoDT)
1853 SbxDateFromUNODateTime(rPar.Get32(0), aUnoDT);
1854 else
1855 SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
1858 // Function to convert date to ISO 8601 date format YYYYMMDD
1859 void SbRtl_CDateToIso(StarBASIC *, SbxArray & rPar, bool)
1861 if ( rPar.Count32() == 2 )
1863 double aDate = rPar.Get32(1)->GetDate();
1865 // Date may actually even be -YYYYYMMDD
1866 char Buffer[11];
1867 sal_Int16 nYear = implGetDateYear( aDate );
1868 snprintf( Buffer, sizeof( Buffer ), (nYear < 0 ? "%05d%02d%02d" : "%04d%02d%02d"),
1869 static_cast<int>(nYear),
1870 static_cast<int>(implGetDateMonth( aDate )),
1871 static_cast<int>(implGetDateDay( aDate )) );
1872 OUString aRetStr = OUString::createFromAscii( Buffer );
1873 rPar.Get32(0)->PutString( aRetStr );
1875 else
1877 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1881 // Function to convert date from ISO 8601 date format YYYYMMDD or YYYY-MM-DD
1882 // And even YYMMDD for compatibility, sigh...
1883 void SbRtl_CDateFromIso(StarBASIC *, SbxArray & rPar, bool)
1885 if ( rPar.Count32() == 2 )
1889 OUString aStr = rPar.Get32(1)->GetOUString();
1890 if (aStr.isEmpty())
1891 break;
1893 // Valid formats are
1894 // YYYYMMDD -YYYMMDD YYYYYMMDD -YYYYYMMDD YYMMDD
1895 // YYYY-MM-DD -YYYY-MM-DD YYYYY-MM-DD -YYYYY-MM-DD
1897 sal_Int32 nSign = 1;
1898 if (aStr[0] == '-')
1900 nSign = -1;
1901 aStr = aStr.copy(1);
1903 const sal_Int32 nLen = aStr.getLength();
1905 // Signed YYMMDD two digit year is invalid.
1906 if (nLen == 6 && nSign == -1)
1907 break;
1909 // Now valid
1910 // YYYYMMDD YYYYYMMDD YYMMDD
1911 // YYYY-MM-DD YYYYY-MM-DD
1912 if (nLen != 6 && (nLen < 8 || 11 < nLen))
1913 break;
1915 bool bUseTwoDigitYear = false;
1916 OUString aYearStr, aMonthStr, aDayStr;
1917 if (nLen == 6 || nLen == 8 || nLen == 9)
1919 // ((Y)YY)YYMMDD
1920 if (!comphelper::string::isdigitAsciiString(aStr))
1921 break;
1923 const sal_Int32 nMonthPos = (nLen == 8 ? 4 : (nLen == 6 ? 2 : 5));
1924 if (nMonthPos == 2)
1925 bUseTwoDigitYear = true;
1926 aYearStr = aStr.copy( 0, nMonthPos );
1927 aMonthStr = aStr.copy( nMonthPos, 2 );
1928 aDayStr = aStr.copy( nMonthPos + 2, 2 );
1930 else
1932 // (Y)YYYY-MM-DD
1933 const sal_Int32 nMonthSep = (nLen == 11 ? 5 : 4);
1934 if (aStr.indexOf('-') != nMonthSep)
1935 break;
1936 if (aStr.indexOf('-', nMonthSep + 1) != nMonthSep + 3)
1937 break;
1939 aYearStr = aStr.copy( 0, nMonthSep );
1940 aMonthStr = aStr.copy( nMonthSep + 1, 2 );
1941 aDayStr = aStr.copy( nMonthSep + 4, 2 );
1942 if ( !comphelper::string::isdigitAsciiString(aYearStr) ||
1943 !comphelper::string::isdigitAsciiString(aMonthStr) ||
1944 !comphelper::string::isdigitAsciiString(aDayStr))
1945 break;
1948 double dDate;
1949 if (!implDateSerial( static_cast<sal_Int16>(nSign * aYearStr.toInt32()),
1950 static_cast<sal_Int16>(aMonthStr.toInt32()), static_cast<sal_Int16>(aDayStr.toInt32()),
1951 bUseTwoDigitYear, SbDateCorrection::None, dDate ))
1952 break;
1954 rPar.Get32(0)->PutDate( dDate );
1956 return;
1958 while (false);
1960 SbxBase::SetError( ERRCODE_BASIC_BAD_PARAMETER );
1962 else
1964 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1968 void SbRtl_DateSerial(StarBASIC *, SbxArray & rPar, bool)
1970 if ( rPar.Count32() < 4 )
1972 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1973 return;
1975 sal_Int16 nYear = rPar.Get32(1)->GetInteger();
1976 sal_Int16 nMonth = rPar.Get32(2)->GetInteger();
1977 sal_Int16 nDay = rPar.Get32(3)->GetInteger();
1979 double dDate;
1980 if( implDateSerial( nYear, nMonth, nDay, true, SbDateCorrection::RollOver, dDate ) )
1982 rPar.Get32(0)->PutDate( dDate );
1986 void SbRtl_TimeSerial(StarBASIC *, SbxArray & rPar, bool)
1988 if ( rPar.Count32() < 4 )
1990 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1991 return;
1993 sal_Int16 nHour = rPar.Get32(1)->GetInteger();
1994 if ( nHour == 24 )
1996 nHour = 0; // because of UNO DateTimes, which go till 24 o'clock
1998 sal_Int16 nMinute = rPar.Get32(2)->GetInteger();
1999 sal_Int16 nSecond = rPar.Get32(3)->GetInteger();
2000 if ((nHour < 0 || nHour > 23) ||
2001 (nMinute < 0 || nMinute > 59 ) ||
2002 (nSecond < 0 || nSecond > 59 ))
2004 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2005 return;
2008 rPar.Get32(0)->PutDate( implTimeSerial(nHour, nMinute, nSecond) ); // JSM
2011 void SbRtl_DateValue(StarBASIC *, SbxArray & rPar, bool)
2013 if ( rPar.Count32() < 2 )
2015 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2017 else
2019 // #39629 check GetSbData()->pInst, can be called from the URL line
2020 std::shared_ptr<SvNumberFormatter> pFormatter;
2021 if( GetSbData()->pInst )
2023 pFormatter = GetSbData()->pInst->GetNumberFormatter();
2025 else
2027 sal_uInt32 n; // Dummy
2028 pFormatter = SbiInstance::PrepareNumberFormatter( n, n, n );
2031 LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
2032 sal_uInt32 nIndex = pFormatter->GetStandardIndex( eLangType);
2033 double fResult;
2034 OUString aStr( rPar.Get32(1)->GetOUString() );
2035 bool bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, fResult );
2036 SvNumFormatType nType = pFormatter->GetType( nIndex );
2038 // DateValue("February 12, 1969") raises error if the system locale is not en_US
2039 // It seems that both locale number formatter and English number
2040 // formatter are supported in Visual Basic.
2041 if( !bSuccess && ( eLangType != LANGUAGE_ENGLISH_US ) )
2043 // Try using LANGUAGE_ENGLISH_US to get the date value.
2044 nIndex = pFormatter->GetStandardIndex( LANGUAGE_ENGLISH_US);
2045 bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, fResult );
2046 nType = pFormatter->GetType( nIndex );
2049 if(bSuccess && (nType==SvNumFormatType::DATE || nType==SvNumFormatType::DATETIME))
2051 if ( nType == SvNumFormatType::DATETIME )
2053 // cut time
2054 if ( fResult > 0.0 )
2056 fResult = floor( fResult );
2058 else
2060 fResult = ceil( fResult );
2063 rPar.Get32(0)->PutDate( fResult );
2065 else
2067 StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
2072 void SbRtl_TimeValue(StarBASIC *, SbxArray & rPar, bool)
2074 if ( rPar.Count32() < 2 )
2076 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2078 else
2080 std::shared_ptr<SvNumberFormatter> pFormatter;
2081 if( GetSbData()->pInst )
2082 pFormatter = GetSbData()->pInst->GetNumberFormatter();
2083 else
2085 sal_uInt32 n;
2086 pFormatter = SbiInstance::PrepareNumberFormatter( n, n, n );
2089 sal_uInt32 nIndex = 0;
2090 double fResult;
2091 bool bSuccess = pFormatter->IsNumberFormat( rPar.Get32(1)->GetOUString(),
2092 nIndex, fResult );
2093 SvNumFormatType nType = pFormatter->GetType(nIndex);
2094 if(bSuccess && (nType==SvNumFormatType::TIME||nType==SvNumFormatType::DATETIME))
2096 if ( nType == SvNumFormatType::DATETIME )
2098 // cut days
2099 fResult = fmod( fResult, 1 );
2101 rPar.Get32(0)->PutDate( fResult );
2103 else
2105 StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
2110 void SbRtl_Day(StarBASIC *, SbxArray & rPar, bool)
2112 if ( rPar.Count32() < 2 )
2114 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2116 else
2118 SbxVariableRef pArg = rPar.Get32(1);
2119 double aDate = pArg->GetDate();
2121 sal_Int16 nDay = implGetDateDay( aDate );
2122 rPar.Get32(0)->PutInteger( nDay );
2126 void SbRtl_Year(StarBASIC *, SbxArray & rPar, bool)
2128 if ( rPar.Count32() < 2 )
2130 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2132 else
2134 sal_Int16 nYear = implGetDateYear( rPar.Get32(1)->GetDate() );
2135 rPar.Get32(0)->PutInteger( nYear );
2139 sal_Int16 implGetHour( double dDate )
2141 double nFrac = dDate - floor( dDate );
2142 nFrac *= 86400.0;
2143 sal_Int32 nSeconds = static_cast<sal_Int32>(nFrac + 0.5);
2144 sal_Int16 nHour = static_cast<sal_Int16>(nSeconds / 3600);
2145 return nHour;
2148 void SbRtl_Hour(StarBASIC *, SbxArray & rPar, bool)
2150 if ( rPar.Count32() < 2 )
2152 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2154 else
2156 double nArg = rPar.Get32(1)->GetDate();
2157 sal_Int16 nHour = implGetHour( nArg );
2158 rPar.Get32(0)->PutInteger( nHour );
2162 void SbRtl_Minute(StarBASIC *, SbxArray & rPar, bool)
2164 if ( rPar.Count32() < 2 )
2166 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2168 else
2170 double nArg = rPar.Get32(1)->GetDate();
2171 sal_Int16 nMin = implGetMinute( nArg );
2172 rPar.Get32(0)->PutInteger( nMin );
2176 void SbRtl_Month(StarBASIC *, SbxArray & rPar, bool)
2178 if ( rPar.Count32() < 2 )
2180 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2182 else
2184 sal_Int16 nMonth = implGetDateMonth( rPar.Get32(1)->GetDate() );
2185 rPar.Get32(0)->PutInteger( nMonth );
2189 sal_Int16 implGetSecond( double dDate )
2191 double nFrac = dDate - floor( dDate );
2192 nFrac *= 86400.0;
2193 sal_Int32 nSeconds = static_cast<sal_Int32>(nFrac + 0.5);
2194 sal_Int16 nTemp = static_cast<sal_Int16>(nSeconds / 3600);
2195 nSeconds -= nTemp * 3600;
2196 nTemp = static_cast<sal_Int16>(nSeconds / 60);
2197 nSeconds -= nTemp * 60;
2199 sal_Int16 nRet = static_cast<sal_Int16>(nSeconds);
2200 return nRet;
2203 void SbRtl_Second(StarBASIC *, SbxArray & rPar, bool)
2205 if ( rPar.Count32() < 2 )
2207 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2209 else
2211 double nArg = rPar.Get32(1)->GetDate();
2212 sal_Int16 nSecond = implGetSecond( nArg );
2213 rPar.Get32(0)->PutInteger( nSecond );
2217 double Now_Impl()
2219 DateTime aDateTime( DateTime::SYSTEM );
2220 double aSerial = static_cast<double>(GetDayDiff( aDateTime ));
2221 tools::Long nSeconds = aDateTime.GetHour();
2222 nSeconds *= 3600;
2223 nSeconds += aDateTime.GetMin() * 60;
2224 nSeconds += aDateTime.GetSec();
2225 double nDays = static_cast<double>(nSeconds) / (24.0*3600.0);
2226 aSerial += nDays;
2227 return aSerial;
2230 // Date Now()
2232 void SbRtl_Now(StarBASIC *, SbxArray & rPar, bool)
2234 rPar.Get32(0)->PutDate( Now_Impl() );
2237 // Date Time()
2239 void SbRtl_Time(StarBASIC *, SbxArray & rPar, bool bWrite)
2241 if ( !bWrite )
2243 tools::Time aTime( tools::Time::SYSTEM );
2244 SbxVariable* pMeth = rPar.Get32(0);
2245 OUString aRes;
2246 if( pMeth->IsFixed() )
2248 // Time$: hh:mm:ss
2249 char buf[ 20 ];
2250 snprintf( buf, sizeof(buf), "%02d:%02d:%02d",
2251 aTime.GetHour(), aTime.GetMin(), aTime.GetSec() );
2252 aRes = OUString::createFromAscii( buf );
2254 else
2256 // Time: system dependent
2257 tools::Long nSeconds=aTime.GetHour();
2258 nSeconds *= 3600;
2259 nSeconds += aTime.GetMin() * 60;
2260 nSeconds += aTime.GetSec();
2261 double nDays = static_cast<double>(nSeconds) * ( 1.0 / (24.0*3600.0) );
2262 const Color* pCol;
2264 std::shared_ptr<SvNumberFormatter> pFormatter;
2265 sal_uInt32 nIndex;
2266 if( GetSbData()->pInst )
2268 pFormatter = GetSbData()->pInst->GetNumberFormatter();
2269 nIndex = GetSbData()->pInst->GetStdTimeIdx();
2271 else
2273 sal_uInt32 n; // Dummy
2274 pFormatter = SbiInstance::PrepareNumberFormatter( n, nIndex, n );
2277 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2279 pMeth->PutString( aRes );
2281 else
2283 StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED );
2287 void SbRtl_Timer(StarBASIC *, SbxArray & rPar, bool)
2289 tools::Time aTime( tools::Time::SYSTEM );
2290 tools::Long nSeconds = aTime.GetHour();
2291 nSeconds *= 3600;
2292 nSeconds += aTime.GetMin() * 60;
2293 nSeconds += aTime.GetSec();
2294 rPar.Get32(0)->PutDate( static_cast<double>(nSeconds) );
2298 void SbRtl_Date(StarBASIC *, SbxArray & rPar, bool bWrite)
2300 if ( !bWrite )
2302 Date aToday( Date::SYSTEM );
2303 double nDays = static_cast<double>(GetDayDiff( aToday ));
2304 SbxVariable* pMeth = rPar.Get32(0);
2305 if( pMeth->IsString() )
2307 OUString aRes;
2308 const Color* pCol;
2310 std::shared_ptr<SvNumberFormatter> pFormatter;
2311 sal_uInt32 nIndex;
2312 if( GetSbData()->pInst )
2314 pFormatter = GetSbData()->pInst->GetNumberFormatter();
2315 nIndex = GetSbData()->pInst->GetStdDateIdx();
2317 else
2319 sal_uInt32 n;
2320 pFormatter = SbiInstance::PrepareNumberFormatter( nIndex, n, n );
2323 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2324 pMeth->PutString( aRes );
2326 else
2328 pMeth->PutDate( nDays );
2331 else
2333 StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED );
2337 void SbRtl_IsArray(StarBASIC *, SbxArray & rPar, bool)
2339 if ( rPar.Count32() < 2 )
2341 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2343 else
2345 rPar.Get32(0)->PutBool((rPar.Get32(1)->GetType() & SbxARRAY) != 0);
2349 void SbRtl_IsObject(StarBASIC *, SbxArray & rPar, bool)
2351 if ( rPar.Count32() < 2 )
2353 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2355 else
2357 SbxVariable* pVar = rPar.Get32(1);
2358 bool bObject = pVar->IsObject();
2359 SbxBase* pObj = (bObject ? pVar->GetObject() : nullptr);
2361 if( auto pUnoClass = dynamic_cast<SbUnoClass*>( pObj) )
2363 bObject = pUnoClass->getUnoClass().is();
2365 rPar.Get32(0)->PutBool( bObject );
2369 void SbRtl_IsDate(StarBASIC *, SbxArray & rPar, bool)
2371 if ( rPar.Count32() < 2 )
2373 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2375 else
2377 // #46134 only string is converted, all other types result in sal_False
2378 SbxVariableRef xArg = rPar.Get32(1);
2379 SbxDataType eType = xArg->GetType();
2380 bool bDate = false;
2382 if( eType == SbxDATE )
2384 bDate = true;
2386 else if( eType == SbxSTRING )
2388 ErrCode nPrevError = SbxBase::GetError();
2389 SbxBase::ResetError();
2391 // force conversion of the parameter to SbxDATE
2392 xArg->SbxValue::GetDate();
2394 bDate = !SbxBase::IsError();
2396 SbxBase::ResetError();
2397 SbxBase::SetError( nPrevError );
2399 rPar.Get32(0)->PutBool( bDate );
2403 void SbRtl_IsEmpty(StarBASIC *, SbxArray & rPar, bool)
2405 if ( rPar.Count32() < 2 )
2407 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2409 else
2411 SbxVariable* pVar = nullptr;
2412 if( SbiRuntime::isVBAEnabled() )
2414 pVar = getDefaultProp( rPar.Get32(1) );
2416 if ( pVar )
2418 pVar->Broadcast( SfxHintId::BasicDataWanted );
2419 rPar.Get32(0)->PutBool( pVar->IsEmpty() );
2421 else
2423 rPar.Get32(0)->PutBool( rPar.Get32(1)->IsEmpty() );
2428 void SbRtl_IsError(StarBASIC *, SbxArray & rPar, bool)
2430 if ( rPar.Count32() < 2 )
2432 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2434 else
2436 SbxVariable* pVar =rPar.Get32(1);
2437 SbUnoObject* pObj = dynamic_cast<SbUnoObject*>( pVar );
2438 if ( !pObj )
2440 if ( SbxBase* pBaseObj = (pVar->IsObject() ? pVar->GetObject() : nullptr) )
2442 pObj = dynamic_cast<SbUnoObject*>( pBaseObj );
2445 uno::Reference< script::XErrorQuery > xError;
2446 if ( pObj )
2448 xError.set( pObj->getUnoAny(), uno::UNO_QUERY );
2450 if ( xError.is() )
2452 rPar.Get32(0)->PutBool( xError->hasError() );
2454 else
2456 rPar.Get32(0)->PutBool( rPar.Get32(1)->IsErr() );
2461 void SbRtl_IsNull(StarBASIC *, SbxArray & rPar, bool)
2463 if ( rPar.Count32() < 2 )
2465 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2467 else
2469 // #51475 because of Uno-objects return true
2470 // even if the pObj value is NULL
2471 SbxVariableRef pArg = rPar.Get32(1);
2472 bool bNull = rPar.Get32(1)->IsNull();
2473 if( !bNull && pArg->GetType() == SbxOBJECT )
2475 SbxBase* pObj = pArg->GetObject();
2476 if( !pObj )
2478 bNull = true;
2481 rPar.Get32(0)->PutBool( bNull );
2485 void SbRtl_IsNumeric(StarBASIC *, SbxArray & rPar, bool)
2487 if ( rPar.Count32() < 2 )
2489 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2491 else
2493 rPar.Get32(0)->PutBool( rPar.Get32(1)->IsNumericRTL() );
2498 void SbRtl_IsMissing(StarBASIC *, SbxArray & rPar, bool)
2500 if ( rPar.Count32() < 2 )
2502 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2504 else
2506 // #57915 Missing is reported by an error
2507 rPar.Get32(0)->PutBool( rPar.Get32(1)->IsErr() );
2511 // Function looks for wildcards, removes them and always returns the pure path
2512 static OUString implSetupWildcard(const OUString& rFileParam, SbiRTLData& rRTLData)
2514 static const char cDelim1 = '/';
2515 static const char cDelim2 = '\\';
2516 static const char cWild1 = '*';
2517 static const char cWild2 = '?';
2519 rRTLData.pWildCard.reset();
2520 rRTLData.sFullNameToBeChecked.clear();
2522 OUString aFileParam = rFileParam;
2523 sal_Int32 nLastWild = aFileParam.lastIndexOf( cWild1 );
2524 if( nLastWild < 0 )
2526 nLastWild = aFileParam.lastIndexOf( cWild2 );
2528 bool bHasWildcards = ( nLastWild >= 0 );
2531 sal_Int32 nLastDelim = aFileParam.lastIndexOf( cDelim1 );
2532 if( nLastDelim < 0 )
2534 nLastDelim = aFileParam.lastIndexOf( cDelim2 );
2536 if( bHasWildcards )
2538 // Wildcards in path?
2539 if( nLastDelim >= 0 && nLastDelim > nLastWild )
2541 return aFileParam;
2544 else
2546 OUString aPathStr = getFullPath( aFileParam );
2547 if( nLastDelim != aFileParam.getLength() - 1 )
2549 rRTLData.sFullNameToBeChecked = aPathStr;
2551 return aPathStr;
2554 OUString aPureFileName;
2555 if( nLastDelim < 0 )
2557 aPureFileName = aFileParam;
2558 aFileParam.clear();
2560 else
2562 aPureFileName = aFileParam.copy( nLastDelim + 1 );
2563 aFileParam = aFileParam.copy( 0, nLastDelim );
2566 // Try again to get a valid URL/UNC-path with only the path
2567 OUString aPathStr = getFullPath( aFileParam );
2569 // Is there a pure file name left? Otherwise the path is
2570 // invalid anyway because it was not accepted by OSL before
2571 if (aPureFileName != "*")
2573 rRTLData.pWildCard = std::make_unique<WildCard>(aPureFileName);
2575 return aPathStr;
2578 static bool implCheckWildcard(const OUString& rName, SbiRTLData const& rRTLData)
2580 bool bMatch = true;
2582 if (rRTLData.pWildCard)
2584 bMatch = rRTLData.pWildCard->Matches(rName);
2586 return bMatch;
2590 static bool isRootDir( const OUString& aDirURLStr )
2592 INetURLObject aDirURLObj( aDirURLStr );
2593 bool bRoot = false;
2595 // Check if it's a root directory
2596 sal_Int32 nCount = aDirURLObj.getSegmentCount();
2598 // No segment means Unix root directory "file:///"
2599 if( nCount == 0 )
2601 bRoot = true;
2603 // Exactly one segment needs further checking, because it
2604 // can be Unix "file:///foo/" -> no root
2605 // or Windows "file:///c:/" -> root
2606 else if( nCount == 1 )
2608 OUString aSeg1 = aDirURLObj.getName( 0, true,
2609 INetURLObject::DecodeMechanism::WithCharset );
2610 if( aSeg1[1] == ':' )
2612 bRoot = true;
2615 // More than one segments can never be root
2616 // so bRoot remains false
2618 return bRoot;
2621 void SbRtl_Dir(StarBASIC *, SbxArray & rPar, bool)
2623 OUString aPath;
2625 const sal_uInt32 nParCount = rPar.Count32();
2626 if( nParCount > 3 )
2628 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2630 else
2632 SbiRTLData& rRTLData = GetSbData()->pInst->GetRTLData();
2634 if( hasUno() )
2636 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
2637 if( xSFI.is() )
2639 if ( nParCount >= 2 )
2641 OUString aFileParam = rPar.Get32(1)->GetOUString();
2643 OUString aFileURLStr = implSetupWildcard(aFileParam, rRTLData);
2644 if (!rRTLData.sFullNameToBeChecked.isEmpty())
2646 bool bExists = false;
2647 try { bExists = xSFI->exists( aFileURLStr ); }
2648 catch(const Exception & ) {}
2650 OUString aNameOnlyStr;
2651 if( bExists )
2653 INetURLObject aFileURL( aFileURLStr );
2654 aNameOnlyStr = aFileURL.getName( INetURLObject::LAST_SEGMENT,
2655 true, INetURLObject::DecodeMechanism::WithCharset );
2657 rPar.Get32(0)->PutString( aNameOnlyStr );
2658 return;
2663 OUString aDirURLStr;
2664 bool bFolder = xSFI->isFolder( aFileURLStr );
2666 if( bFolder )
2668 aDirURLStr = aFileURLStr;
2670 else
2672 rPar.Get32(0)->PutString( "" );
2675 SbAttributes nFlags = SbAttributes::NONE;
2676 if ( nParCount > 2 )
2678 rRTLData.nDirFlags = nFlags
2679 = static_cast<SbAttributes>(rPar.Get32(2)->GetInteger());
2681 else
2683 rRTLData.nDirFlags = SbAttributes::NONE;
2685 // Read directory
2686 bool bIncludeFolders = bool(nFlags & SbAttributes::DIRECTORY);
2687 rRTLData.aDirSeq = xSFI->getFolderContents(aDirURLStr, bIncludeFolders);
2688 rRTLData.nCurDirPos = 0;
2690 // #78651 Add "." and ".." directories for VB compatibility
2691 if( bIncludeFolders )
2693 bool bRoot = isRootDir( aDirURLStr );
2695 // If it's no root directory we flag the need for
2696 // the "." and ".." directories by the value -2
2697 // for the actual position. Later for -2 will be
2698 // returned "." and for -1 ".."
2699 if( !bRoot )
2701 rRTLData.nCurDirPos = -2;
2705 catch(const Exception & )
2711 if (rRTLData.aDirSeq.hasElements())
2713 bool bFolderFlag = bool(rRTLData.nDirFlags & SbAttributes::DIRECTORY);
2715 SbiInstance* pInst = GetSbData()->pInst;
2716 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
2717 for( ;; )
2719 if (rRTLData.nCurDirPos < 0)
2721 if (rRTLData.nCurDirPos == -2)
2723 aPath = ".";
2725 else if (rRTLData.nCurDirPos == -1)
2727 aPath = "..";
2729 rRTLData.nCurDirPos++;
2731 else if (rRTLData.nCurDirPos >= rRTLData.aDirSeq.getLength())
2733 rRTLData.aDirSeq.realloc(0);
2734 aPath.clear();
2735 break;
2737 else
2739 OUString aFile
2740 = rRTLData.aDirSeq.getConstArray()[rRTLData.nCurDirPos++];
2742 if( bCompatibility )
2744 if( !bFolderFlag )
2746 bool bFolder = xSFI->isFolder( aFile );
2747 if( bFolder )
2749 continue;
2753 else
2755 // Only directories
2756 if( bFolderFlag )
2758 bool bFolder = xSFI->isFolder( aFile );
2759 if( !bFolder )
2761 continue;
2766 INetURLObject aURL( aFile );
2767 aPath = aURL.getName( INetURLObject::LAST_SEGMENT, true,
2768 INetURLObject::DecodeMechanism::WithCharset );
2771 bool bMatch = implCheckWildcard(aPath, rRTLData);
2772 if( !bMatch )
2774 continue;
2776 break;
2779 rPar.Get32(0)->PutString( aPath );
2782 else
2784 // TODO: OSL
2785 if ( nParCount >= 2 )
2787 OUString aFileParam = rPar.Get32(1)->GetOUString();
2789 OUString aDirURL = implSetupWildcard(aFileParam, rRTLData);
2791 SbAttributes nFlags = SbAttributes::NONE;
2792 if ( nParCount > 2 )
2794 rRTLData.nDirFlags = nFlags
2795 = static_cast<SbAttributes>(rPar.Get32(2)->GetInteger());
2797 else
2799 rRTLData.nDirFlags = SbAttributes::NONE;
2802 // Read directory
2803 bool bIncludeFolders = bool(nFlags & SbAttributes::DIRECTORY);
2804 rRTLData.pDir = std::make_unique<Directory>(aDirURL);
2805 FileBase::RC nRet = rRTLData.pDir->open();
2806 if( nRet != FileBase::E_None )
2808 rRTLData.pDir.reset();
2809 rPar.Get32(0)->PutString( OUString() );
2810 return;
2813 // #86950 Add "." and ".." directories for VB compatibility
2814 rRTLData.nCurDirPos = 0;
2815 if( bIncludeFolders )
2817 bool bRoot = isRootDir( aDirURL );
2819 // If it's no root directory we flag the need for
2820 // the "." and ".." directories by the value -2
2821 // for the actual position. Later for -2 will be
2822 // returned "." and for -1 ".."
2823 if( !bRoot )
2825 rRTLData.nCurDirPos = -2;
2831 if (rRTLData.pDir)
2833 bool bFolderFlag = bool(rRTLData.nDirFlags & SbAttributes::DIRECTORY);
2834 for( ;; )
2836 if (rRTLData.nCurDirPos < 0)
2838 if (rRTLData.nCurDirPos == -2)
2840 aPath = ".";
2842 else if (rRTLData.nCurDirPos == -1)
2844 aPath = "..";
2846 rRTLData.nCurDirPos++;
2848 else
2850 DirectoryItem aItem;
2851 FileBase::RC nRet = rRTLData.pDir->getNextItem(aItem);
2852 if( nRet != FileBase::E_None )
2854 rRTLData.pDir.reset();
2855 aPath.clear();
2856 break;
2859 // Handle flags
2860 FileStatus aFileStatus( osl_FileStatus_Mask_Type | osl_FileStatus_Mask_FileName );
2861 nRet = aItem.getFileStatus( aFileStatus );
2862 if( nRet != FileBase::E_None )
2864 SAL_WARN("basic", "getFileStatus failed");
2865 continue;
2868 // Only directories?
2869 if( bFolderFlag )
2871 FileStatus::Type aType = aFileStatus.getFileType();
2872 bool bFolder = isFolder( aType );
2873 if( !bFolder )
2875 continue;
2879 aPath = aFileStatus.getFileName();
2882 bool bMatch = implCheckWildcard(aPath, rRTLData);
2883 if( !bMatch )
2885 continue;
2887 break;
2890 rPar.Get32(0)->PutString( aPath );
2896 void SbRtl_GetAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
2898 (void)pBasic;
2899 (void)bWrite;
2901 if ( rPar.Count32() == 2 )
2903 sal_Int16 nFlags = 0;
2905 // In Windows, we want to use Windows API to get the file attributes
2906 // for VBA interoperability.
2907 #if defined(_WIN32)
2908 if( SbiRuntime::isVBAEnabled() )
2910 OUString aPathURL = getFullPath( rPar.Get32(1)->GetOUString() );
2911 OUString aPath;
2912 FileBase::getSystemPathFromFileURL( aPathURL, aPath );
2913 DWORD nRealFlags = GetFileAttributesW (o3tl::toW(aPath.getStr()));
2914 if (nRealFlags != 0xffffffff)
2916 if (nRealFlags == FILE_ATTRIBUTE_NORMAL)
2918 nRealFlags = 0;
2920 nFlags = static_cast<sal_Int16>(nRealFlags);
2922 else
2924 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
2926 rPar.Get32(0)->PutInteger( nFlags );
2928 return;
2930 #endif
2932 if( hasUno() )
2934 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
2935 if( xSFI.is() )
2939 OUString aPath = getFullPath( rPar.Get32(1)->GetOUString() );
2940 bool bExists = false;
2941 try { bExists = xSFI->exists( aPath ); }
2942 catch(const Exception & ) {}
2943 if( !bExists )
2945 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
2946 return;
2949 bool bReadOnly = xSFI->isReadOnly( aPath );
2950 bool bHidden = xSFI->isHidden( aPath );
2951 bool bDirectory = xSFI->isFolder( aPath );
2952 if( bReadOnly )
2954 nFlags |= sal_uInt16(SbAttributes::READONLY);
2956 if( bHidden )
2958 nFlags |= sal_uInt16(SbAttributes::HIDDEN);
2960 if( bDirectory )
2962 nFlags |= sal_uInt16(SbAttributes::DIRECTORY);
2965 catch(const Exception & )
2967 StarBASIC::Error( ERRCODE_IO_GENERAL );
2971 else
2973 DirectoryItem aItem;
2974 (void)DirectoryItem::get( getFullPath( rPar.Get32(1)->GetOUString() ), aItem );
2975 FileStatus aFileStatus( osl_FileStatus_Mask_Attributes | osl_FileStatus_Mask_Type );
2976 (void)aItem.getFileStatus( aFileStatus );
2977 sal_uInt64 nAttributes = aFileStatus.getAttributes();
2978 bool bReadOnly = (nAttributes & osl_File_Attribute_ReadOnly) != 0;
2980 FileStatus::Type aType = aFileStatus.getFileType();
2981 bool bDirectory = isFolder( aType );
2982 if( bReadOnly )
2984 nFlags |= sal_uInt16(SbAttributes::READONLY);
2986 if( bDirectory )
2988 nFlags |= sal_uInt16(SbAttributes::DIRECTORY);
2991 rPar.Get32(0)->PutInteger( nFlags );
2993 else
2995 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3000 void SbRtl_FileDateTime(StarBASIC *, SbxArray & rPar, bool)
3002 if ( rPar.Count32() != 2 )
3004 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3006 else
3008 OUString aPath = rPar.Get32(1)->GetOUString();
3009 tools::Time aTime( tools::Time::EMPTY );
3010 Date aDate( Date::EMPTY );
3011 if( hasUno() )
3013 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
3014 if( xSFI.is() )
3018 util::DateTime aUnoDT = xSFI->getDateTimeModified( aPath );
3019 aTime = tools::Time( aUnoDT );
3020 aDate = Date( aUnoDT );
3022 catch(const Exception & )
3024 StarBASIC::Error( ERRCODE_IO_GENERAL );
3028 else
3030 bool bSuccess = false;
3033 DirectoryItem aItem;
3034 if (DirectoryItem::get( getFullPath( aPath ), aItem ) != FileBase::E_None)
3035 break;
3037 FileStatus aFileStatus( osl_FileStatus_Mask_ModifyTime );
3038 if (aItem.getFileStatus( aFileStatus ) != FileBase::E_None)
3039 break;
3041 TimeValue aTimeVal = aFileStatus.getModifyTime();
3042 oslDateTime aDT;
3043 if (!osl_getDateTimeFromTimeValue( &aTimeVal, &aDT ))
3044 // Strictly spoken this is not an i/o error but some other failure.
3045 break;
3047 aTime = tools::Time( aDT.Hours, aDT.Minutes, aDT.Seconds, aDT.NanoSeconds );
3048 aDate = Date( aDT.Day, aDT.Month, aDT.Year );
3049 bSuccess = true;
3051 while(false);
3053 if (!bSuccess)
3054 StarBASIC::Error( ERRCODE_IO_GENERAL );
3057 // An empty date shall not result in a formatted null-date (1899-12-30
3058 // or 1900-01-01) or even worse -0001-12-03 or some such due to how
3059 // GetDayDiff() treats things. There should be an error set in this
3060 // case anyway because of a missing file or other error above, but... so
3061 // do not even bother to use the number formatter.
3062 OUString aRes;
3063 if (aDate.IsEmpty())
3065 aRes = "0000-00-00 00:00:00";
3067 else
3069 double fSerial = static_cast<double>(GetDayDiff( aDate ));
3070 tools::Long nSeconds = aTime.GetHour();
3071 nSeconds *= 3600;
3072 nSeconds += aTime.GetMin() * 60;
3073 nSeconds += aTime.GetSec();
3074 double nDays = static_cast<double>(nSeconds) / (24.0*3600.0);
3075 fSerial += nDays;
3077 const Color* pCol;
3079 std::shared_ptr<SvNumberFormatter> pFormatter;
3080 sal_uInt32 nIndex;
3081 if( GetSbData()->pInst )
3083 pFormatter = GetSbData()->pInst->GetNumberFormatter();
3084 nIndex = GetSbData()->pInst->GetStdDateTimeIdx();
3086 else
3088 sal_uInt32 n;
3089 pFormatter = SbiInstance::PrepareNumberFormatter( n, n, nIndex );
3092 pFormatter->GetOutputString( fSerial, nIndex, aRes, &pCol );
3094 rPar.Get32(0)->PutString( aRes );
3099 void SbRtl_EOF(StarBASIC *, SbxArray & rPar, bool)
3101 // No changes for UCB
3102 if ( rPar.Count32() != 2 )
3104 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3106 else
3108 sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
3109 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3110 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3111 if ( !pSbStrm )
3113 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3114 return;
3116 bool beof;
3117 SvStream* pSvStrm = pSbStrm->GetStrm();
3118 if ( pSbStrm->IsText() )
3120 char cBla;
3121 (*pSvStrm).ReadChar( cBla ); // can we read another character?
3122 beof = pSvStrm->eof();
3123 if ( !beof )
3125 pSvStrm->SeekRel( -1 );
3128 else
3130 beof = pSvStrm->eof(); // for binary data!
3132 rPar.Get32(0)->PutBool( beof );
3136 void SbRtl_FileAttr(StarBASIC *, SbxArray & rPar, bool)
3138 // No changes for UCB
3139 // #57064 Although this function doesn't operate with DirEntry, it is
3140 // not touched by the adjustment to virtual URLs, as it only works on
3141 // already opened files and the name doesn't matter there.
3143 if ( rPar.Count32() != 3 )
3145 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3147 else
3149 sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
3150 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3151 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3152 if ( !pSbStrm )
3154 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3155 return;
3157 sal_Int16 nRet;
3158 if ( rPar.Get32(2)->GetInteger() == 1 )
3160 nRet = static_cast<sal_Int16>(pSbStrm->GetMode());
3162 else
3164 nRet = 0; // System file handle not supported
3166 rPar.Get32(0)->PutInteger( nRet );
3169 void SbRtl_Loc(StarBASIC *, SbxArray & rPar, bool)
3171 // No changes for UCB
3172 if ( rPar.Count32() != 2 )
3174 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3176 else
3178 sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
3179 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3180 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3181 if ( !pSbStrm )
3183 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3184 return;
3186 SvStream* pSvStrm = pSbStrm->GetStrm();
3187 std::size_t nPos;
3188 if( pSbStrm->IsRandom())
3190 short nBlockLen = pSbStrm->GetBlockLen();
3191 nPos = nBlockLen ? (pSvStrm->Tell() / nBlockLen) : 0;
3192 nPos++; // block positions starting at 1
3194 else if ( pSbStrm->IsText() )
3196 nPos = pSbStrm->GetLine();
3198 else if( pSbStrm->IsBinary() )
3200 nPos = pSvStrm->Tell();
3202 else if ( pSbStrm->IsSeq() )
3204 nPos = ( pSvStrm->Tell()+1 ) / 128;
3206 else
3208 nPos = pSvStrm->Tell();
3210 rPar.Get32(0)->PutLong( static_cast<sal_Int32>(nPos) );
3214 void SbRtl_Lof(StarBASIC *, SbxArray & rPar, bool)
3216 // No changes for UCB
3217 if ( rPar.Count32() != 2 )
3219 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3221 else
3223 sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
3224 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3225 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3226 if ( !pSbStrm )
3228 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3229 return;
3231 SvStream* pSvStrm = pSbStrm->GetStrm();
3232 sal_uInt64 const nLen = pSvStrm->TellEnd();
3233 rPar.Get32(0)->PutLong( static_cast<sal_Int32>(nLen) );
3238 void SbRtl_Seek(StarBASIC *, SbxArray & rPar, bool)
3240 // No changes for UCB
3241 int nArgs = static_cast<int>(rPar.Count32());
3242 if ( nArgs < 2 || nArgs > 3 )
3244 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3245 return;
3247 sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
3248 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3249 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3250 if ( !pSbStrm )
3252 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3253 return;
3255 SvStream* pStrm = pSbStrm->GetStrm();
3257 if ( nArgs == 2 ) // Seek-Function
3259 sal_uInt64 nPos = pStrm->Tell();
3260 if( pSbStrm->IsRandom() )
3262 nPos = nPos / pSbStrm->GetBlockLen();
3264 nPos++; // Basic counts from 1
3265 rPar.Get32(0)->PutLong( static_cast<sal_Int32>(nPos) );
3267 else // Seek-Statement
3269 sal_Int32 nPos = rPar.Get32(2)->GetLong();
3270 if ( nPos < 1 )
3272 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3273 return;
3275 nPos--; // Basic counts from 1, SvStreams count from 0
3276 pSbStrm->SetExpandOnWriteTo( 0 );
3277 if ( pSbStrm->IsRandom() )
3279 nPos *= pSbStrm->GetBlockLen();
3281 pStrm->Seek( static_cast<sal_uInt64>(nPos) );
3282 pSbStrm->SetExpandOnWriteTo( nPos );
3286 void SbRtl_Format(StarBASIC *, SbxArray & rPar, bool)
3288 const sal_uInt32 nArgCount = rPar.Count32();
3289 if ( nArgCount < 2 || nArgCount > 3 )
3291 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3293 else
3295 OUString aResult;
3296 if( nArgCount == 2 )
3298 rPar.Get32(1)->Format( aResult );
3300 else
3302 OUString aFmt( rPar.Get32(2)->GetOUString() );
3303 rPar.Get32(1)->Format( aResult, &aFmt );
3305 rPar.Get32(0)->PutString( aResult );
3309 // https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/formatnumber-function
3310 void SbRtl_FormatNumber(StarBASIC*, SbxArray& rPar, bool)
3312 const sal_uInt32 nArgCount = rPar.Count32();
3313 if (nArgCount < 2 || nArgCount > 6)
3315 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3316 return;
3319 // The UI locale never changes -> we can use static value here
3320 static const LocaleDataWrapper localeData(Application::GetSettings().GetUILanguageTag());
3321 sal_Int16 nNumDigitsAfterDecimal = -1;
3322 if (nArgCount > 2 && !rPar.Get32(2)->IsEmpty())
3324 nNumDigitsAfterDecimal = rPar.Get32(2)->GetInteger();
3325 if (nNumDigitsAfterDecimal < -1)
3327 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3328 return;
3330 else if (nNumDigitsAfterDecimal > 255)
3331 nNumDigitsAfterDecimal %= 256;
3333 if (nNumDigitsAfterDecimal == -1)
3334 nNumDigitsAfterDecimal = LocaleDataWrapper::getNumDigits();
3336 bool bIncludeLeadingDigit = LocaleDataWrapper::isNumLeadingZero();
3337 if (nArgCount > 3 && !rPar.Get32(3)->IsEmpty())
3339 switch (rPar.Get32(3)->GetInteger())
3341 case ooo::vba::VbTriState::vbFalse:
3342 bIncludeLeadingDigit = false;
3343 break;
3344 case ooo::vba::VbTriState::vbTrue:
3345 bIncludeLeadingDigit = true;
3346 break;
3347 case ooo::vba::VbTriState::vbUseDefault:
3348 // do nothing;
3349 break;
3350 default:
3351 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3352 return;
3356 bool bUseParensForNegativeNumbers = false;
3357 if (nArgCount > 4 && !rPar.Get32(4)->IsEmpty())
3359 switch (rPar.Get32(4)->GetInteger())
3361 case ooo::vba::VbTriState::vbFalse:
3362 case ooo::vba::VbTriState::vbUseDefault:
3363 // do nothing
3364 break;
3365 case ooo::vba::VbTriState::vbTrue:
3366 bUseParensForNegativeNumbers = true;
3367 break;
3368 default:
3369 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3370 return;
3374 bool bGroupDigits = false;
3375 if (nArgCount > 5 && !rPar.Get32(5)->IsEmpty())
3377 switch (rPar.Get32(5)->GetInteger())
3379 case ooo::vba::VbTriState::vbFalse:
3380 case ooo::vba::VbTriState::vbUseDefault:
3381 // do nothing
3382 break;
3383 case ooo::vba::VbTriState::vbTrue:
3384 bGroupDigits = true;
3385 break;
3386 default:
3387 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3388 return;
3392 double fVal = rPar.Get32(1)->GetDouble();
3393 const bool bNegative = fVal < 0;
3394 if (bNegative)
3395 fVal = fabs(fVal); // Always work with non-negatives, to easily handle leading zero
3397 static const sal_Unicode decSep = localeData.getNumDecimalSep().toChar();
3398 OUString aResult = rtl::math::doubleToUString(
3399 fVal, rtl_math_StringFormat_F, nNumDigitsAfterDecimal, decSep,
3400 bGroupDigits ? localeData.getDigitGrouping().getConstArray() : nullptr,
3401 localeData.getNumThousandSep().toChar());
3403 if (!bIncludeLeadingDigit && aResult.getLength() > 1 && aResult.startsWith("0"))
3404 aResult = aResult.copy(1);
3406 if (nNumDigitsAfterDecimal > 0)
3408 sal_Int32 nActualDigits;
3409 const sal_Int32 nSepPos = aResult.indexOf(decSep);
3410 if (nSepPos == -1)
3411 nActualDigits = 0;
3412 else
3413 nActualDigits = aResult.getLength() - nSepPos - 1;
3415 // VBA allows up to 255 digits; rtl::math::doubleToUString outputs up to 15 digits
3416 // for ~small numbers, so pad them as appropriate.
3417 if (nActualDigits < nNumDigitsAfterDecimal)
3419 OUStringBuffer sBuf;
3420 comphelper::string::padToLength(sBuf, nNumDigitsAfterDecimal - nActualDigits, '0');
3421 aResult += sBuf;
3425 if (bNegative)
3427 if (bUseParensForNegativeNumbers)
3428 aResult = "(" + aResult + ")";
3429 else
3430 aResult = "-" + aResult;
3433 rPar.Get32(0)->PutString(aResult);
3436 namespace {
3438 // note: BASIC does not use comphelper::random, because
3439 // Randomize(int) must be supported and should not affect non-BASIC random use
3440 struct RandomNumberGenerator
3442 std::mt19937 global_rng;
3444 RandomNumberGenerator()
3448 std::random_device rd;
3449 // initialises the state of the global random number generator
3450 // should only be called once.
3451 // (note, a few std::variate_generator<> (like normal) have their
3452 // own state which would need a reset as well to guarantee identical
3453 // sequence of numbers, e.g. via myrand.distribution().reset())
3454 global_rng.seed(rd() ^ time(nullptr));
3456 catch (std::runtime_error& e)
3458 SAL_WARN("basic", "Using std::random_device failed: " << e.what());
3459 global_rng.seed(time(nullptr));
3464 class theRandomNumberGenerator : public rtl::Static<RandomNumberGenerator, theRandomNumberGenerator> {};
3468 void SbRtl_Randomize(StarBASIC *, SbxArray & rPar, bool)
3470 if ( rPar.Count32() > 2 )
3472 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3474 if( rPar.Count32() == 2 )
3476 int nSeed = static_cast<int>(rPar.Get32(1)->GetInteger());
3477 theRandomNumberGenerator::get().global_rng.seed(nSeed);
3479 // without parameter, no need to do anything - RNG is seeded at first use
3482 void SbRtl_Rnd(StarBASIC *, SbxArray & rPar, bool)
3484 if ( rPar.Count32() > 2 )
3486 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3488 else
3490 std::uniform_real_distribution<double> dist(0.0, 1.0);
3491 double const tmp(dist(theRandomNumberGenerator::get().global_rng));
3492 rPar.Get32(0)->PutDouble(tmp);
3497 // Syntax: Shell("Path",[ Window-Style,[ "Params", [ bSync = sal_False ]]])
3498 // WindowStyles (VBA compatible):
3499 // 2 == Minimized
3500 // 3 == Maximized
3501 // 10 == Full-Screen (text mode applications OS/2, WIN95, WNT)
3502 // HACK: The WindowStyle will be passed to
3503 // Application::StartApp in Creator. Format: "xxxx2"
3506 void SbRtl_Shell(StarBASIC *, SbxArray & rPar, bool)
3508 const sal_uInt32 nArgCount = rPar.Count32();
3509 if ( nArgCount < 2 || nArgCount > 5 )
3511 rPar.Get32(0)->PutLong(0);
3512 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3514 else
3516 oslProcessOption nOptions = osl_Process_SEARCHPATH | osl_Process_DETACHED;
3518 OUString aCmdLine = rPar.Get32(1)->GetOUString();
3519 // attach additional parameters - everything must be parsed anyway
3520 if( nArgCount >= 4 )
3522 OUString tmp = rPar.Get32(3)->GetOUString().trim();
3523 if (!tmp.isEmpty())
3525 aCmdLine += " " + tmp;
3528 else if( aCmdLine.isEmpty() )
3530 // avoid special treatment (empty list)
3531 aCmdLine += " ";
3533 sal_Int32 nLen = aCmdLine.getLength();
3535 // #55735 if there are parameters, they have to be separated
3536 // #72471 also separate the single parameters
3537 std::vector<OUString> aTokenVector;
3538 OUString aToken;
3539 sal_Int32 i = 0;
3540 sal_Unicode c;
3541 while( i < nLen )
3543 for ( ;; ++i )
3545 c = aCmdLine[ i ];
3546 if ( c != ' ' && c != '\t' )
3548 break;
3552 if( c == '\"' || c == '\'' )
3554 sal_Int32 iFoundPos = aCmdLine.indexOf( c, i + 1 );
3556 if( iFoundPos < 0 )
3558 aToken = aCmdLine.copy( i);
3559 i = nLen;
3561 else
3563 aToken = aCmdLine.copy( i + 1, (iFoundPos - i - 1) );
3564 i = iFoundPos + 1;
3567 else
3569 sal_Int32 iFoundSpacePos = aCmdLine.indexOf( ' ', i );
3570 sal_Int32 iFoundTabPos = aCmdLine.indexOf( '\t', i );
3571 sal_Int32 iFoundPos = iFoundSpacePos >= 0 ? iFoundTabPos >= 0 ? std::min( iFoundSpacePos, iFoundTabPos ) : iFoundSpacePos : -1;
3573 if( iFoundPos < 0 )
3575 aToken = aCmdLine.copy( i );
3576 i = nLen;
3578 else
3580 aToken = aCmdLine.copy( i, (iFoundPos - i) );
3581 i = iFoundPos;
3585 // insert into the list
3586 aTokenVector.push_back( aToken );
3588 // #55735 / #72471 end
3590 sal_Int16 nWinStyle = 0;
3591 if( nArgCount >= 3 )
3593 nWinStyle = rPar.Get32(2)->GetInteger();
3594 switch( nWinStyle )
3596 case 2:
3597 nOptions |= osl_Process_MINIMIZED;
3598 break;
3599 case 3:
3600 nOptions |= osl_Process_MAXIMIZED;
3601 break;
3602 case 10:
3603 nOptions |= osl_Process_FULLSCREEN;
3604 break;
3607 bool bSync = false;
3608 if( nArgCount >= 5 )
3610 bSync = rPar.Get32(4)->GetBool();
3612 if( bSync )
3614 nOptions |= osl_Process_WAIT;
3618 // #72471 work parameter(s) up
3619 std::vector<OUString>::const_iterator iter = aTokenVector.begin();
3620 OUString aOUStrProgURL = getFullPath( *iter );
3622 ++iter;
3624 sal_uInt16 nParamCount = sal::static_int_cast< sal_uInt16 >(aTokenVector.size() - 1 );
3625 std::unique_ptr<rtl_uString*[]> pParamList;
3626 if( nParamCount )
3628 pParamList.reset( new rtl_uString*[nParamCount]);
3629 for(int iVector = 0; iter != aTokenVector.end(); ++iVector, ++iter)
3631 const OUString& rParamStr = *iter;
3632 pParamList[iVector] = nullptr;
3633 rtl_uString_assign(&(pParamList[iVector]), rParamStr.pData);
3637 oslProcess pApp;
3638 bool bSucc = osl_executeProcess(
3639 aOUStrProgURL.pData,
3640 pParamList.get(),
3641 nParamCount,
3642 nOptions,
3643 nullptr,
3644 nullptr,
3645 nullptr, 0,
3646 &pApp ) == osl_Process_E_None;
3648 // 53521 only free process handle on success
3649 if (bSucc)
3651 osl_freeProcessHandle( pApp );
3654 for(int j = 0; j < nParamCount; ++j)
3656 rtl_uString_release(pParamList[j]);
3659 if( !bSucc )
3661 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
3663 else
3665 rPar.Get32(0)->PutLong( 0 );
3670 void SbRtl_VarType(StarBASIC *, SbxArray & rPar, bool)
3672 if ( rPar.Count32() != 2 )
3674 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3676 else
3678 SbxDataType eType = rPar.Get32(1)->GetType();
3679 rPar.Get32(0)->PutInteger( static_cast<sal_Int16>(eType) );
3683 // Exported function
3684 OUString getBasicTypeName( SbxDataType eType )
3686 static const char* pTypeNames[] =
3688 "Empty", // SbxEMPTY
3689 "Null", // SbxNULL
3690 "Integer", // SbxINTEGER
3691 "Long", // SbxLONG
3692 "Single", // SbxSINGLE
3693 "Double", // SbxDOUBLE
3694 "Currency", // SbxCURRENCY
3695 "Date", // SbxDATE
3696 "String", // SbxSTRING
3697 "Object", // SbxOBJECT
3698 "Error", // SbxERROR
3699 "Boolean", // SbxBOOL
3700 "Variant", // SbxVARIANT
3701 "DataObject", // SbxDATAOBJECT
3702 "Unknown Type",
3703 "Unknown Type",
3704 "Char", // SbxCHAR
3705 "Byte", // SbxBYTE
3706 "UShort", // SbxUSHORT
3707 "ULong", // SbxULONG
3708 "Long64", // SbxLONG64
3709 "ULong64", // SbxULONG64
3710 "Int", // SbxINT
3711 "UInt", // SbxUINT
3712 "Void", // SbxVOID
3713 "HResult", // SbxHRESULT
3714 "Pointer", // SbxPOINTER
3715 "DimArray", // SbxDIMARRAY
3716 "CArray", // SbxCARRAY
3717 "Userdef", // SbxUSERDEF
3718 "Lpstr", // SbxLPSTR
3719 "Lpwstr", // SbxLPWSTR
3720 "Unknown Type", // SbxCoreSTRING
3721 "WString", // SbxWSTRING
3722 "WChar", // SbxWCHAR
3723 "Int64", // SbxSALINT64
3724 "UInt64", // SbxSALUINT64
3725 "Decimal", // SbxDECIMAL
3728 size_t nPos = static_cast<size_t>(eType) & 0x0FFF;
3729 const size_t nTypeNameCount = SAL_N_ELEMENTS( pTypeNames );
3730 if ( nPos >= nTypeNameCount )
3732 nPos = nTypeNameCount - 1;
3734 return OUString::createFromAscii(pTypeNames[nPos]);
3737 static OUString getObjectTypeName( SbxVariable* pVar )
3739 OUString sRet( "Object" );
3740 if ( pVar )
3742 SbxBase* pBaseObj = pVar->GetObject();
3743 if( !pBaseObj )
3745 sRet = "Nothing";
3747 else
3749 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pVar );
3750 if ( !pUnoObj )
3752 pUnoObj = dynamic_cast<SbUnoObject*>( pBaseObj );
3754 if ( pUnoObj )
3756 Any aObj = pUnoObj->getUnoAny();
3757 // For upstreaming unless we start to build oovbaapi by default
3758 // we need to get detect the vba-ness of the object in some
3759 // other way
3760 // note: Automation objects do not support XServiceInfo
3761 uno::Reference< XServiceInfo > xServInfo( aObj, uno::UNO_QUERY );
3762 if ( xServInfo.is() )
3764 // is this a VBA object ?
3765 Sequence< OUString > sServices = xServInfo->getSupportedServiceNames();
3766 if ( sServices.hasElements() )
3768 sRet = sServices[ 0 ];
3771 else
3773 uno::Reference< bridge::oleautomation::XAutomationObject > xAutoMation( aObj, uno::UNO_QUERY );
3774 if ( xAutoMation.is() )
3776 uno::Reference< script::XInvocation > xInv( aObj, uno::UNO_QUERY );
3777 if ( xInv.is() )
3781 xInv->getValue( "$GetTypeName" ) >>= sRet;
3783 catch(const Exception& )
3789 sal_Int32 nDot = sRet.lastIndexOf( '.' );
3790 if ( nDot != -1 && nDot < sRet.getLength() )
3792 sRet = sRet.copy( nDot + 1 );
3797 return sRet;
3800 void SbRtl_TypeName(StarBASIC *, SbxArray & rPar, bool)
3802 if ( rPar.Count32() != 2 )
3804 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3806 else
3808 SbxDataType eType = rPar.Get32(1)->GetType();
3809 bool bIsArray = ( ( eType & SbxARRAY ) != 0 );
3811 OUString aRetStr;
3812 if ( SbiRuntime::isVBAEnabled() && eType == SbxOBJECT )
3814 aRetStr = getObjectTypeName( rPar.Get32(1) );
3816 else
3818 aRetStr = getBasicTypeName( eType );
3820 if( bIsArray )
3822 aRetStr += "()";
3824 rPar.Get32(0)->PutString( aRetStr );
3828 void SbRtl_Len(StarBASIC *, SbxArray & rPar, bool)
3830 if ( rPar.Count32() != 2 )
3832 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3834 else
3836 const OUString& rStr = rPar.Get32(1)->GetOUString();
3837 rPar.Get32(0)->PutLong( rStr.getLength() );
3841 void SbRtl_DDEInitiate(StarBASIC *, SbxArray & rPar, bool)
3843 int nArgs = static_cast<int>(rPar.Count32());
3844 if ( nArgs != 3 )
3846 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3847 return;
3849 const OUString& rApp = rPar.Get32(1)->GetOUString();
3850 const OUString& rTopic = rPar.Get32(2)->GetOUString();
3852 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3853 size_t nChannel;
3854 ErrCode nDdeErr = pDDE->Initiate( rApp, rTopic, nChannel );
3855 if( nDdeErr )
3857 StarBASIC::Error( nDdeErr );
3859 else
3861 rPar.Get32(0)->PutInteger( static_cast<sal_Int16>(nChannel) );
3865 void SbRtl_DDETerminate(StarBASIC *, SbxArray & rPar, bool)
3867 rPar.Get32(0)->PutEmpty();
3868 int nArgs = static_cast<int>(rPar.Count32());
3869 if ( nArgs != 2 )
3871 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3872 return;
3874 size_t nChannel = rPar.Get32(1)->GetInteger();
3875 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3876 ErrCode nDdeErr = pDDE->Terminate( nChannel );
3877 if( nDdeErr )
3879 StarBASIC::Error( nDdeErr );
3883 void SbRtl_DDETerminateAll(StarBASIC *, SbxArray & rPar, bool)
3885 rPar.Get32(0)->PutEmpty();
3886 int nArgs = static_cast<int>(rPar.Count32());
3887 if ( nArgs != 1 )
3889 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3890 return;
3893 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3894 ErrCode nDdeErr = pDDE->TerminateAll();
3895 if( nDdeErr )
3897 StarBASIC::Error( nDdeErr );
3901 void SbRtl_DDERequest(StarBASIC *, SbxArray & rPar, bool)
3903 int nArgs = static_cast<int>(rPar.Count32());
3904 if ( nArgs != 3 )
3906 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3907 return;
3909 size_t nChannel = rPar.Get32(1)->GetInteger();
3910 const OUString& rItem = rPar.Get32(2)->GetOUString();
3911 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3912 OUString aResult;
3913 ErrCode nDdeErr = pDDE->Request( nChannel, rItem, aResult );
3914 if( nDdeErr )
3916 StarBASIC::Error( nDdeErr );
3918 else
3920 rPar.Get32(0)->PutString( aResult );
3924 void SbRtl_DDEExecute(StarBASIC *, SbxArray & rPar, bool)
3926 rPar.Get32(0)->PutEmpty();
3927 int nArgs = static_cast<int>(rPar.Count32());
3928 if ( nArgs != 3 )
3930 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3931 return;
3933 size_t nChannel = rPar.Get32(1)->GetInteger();
3934 const OUString& rCommand = rPar.Get32(2)->GetOUString();
3935 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3936 ErrCode nDdeErr = pDDE->Execute( nChannel, rCommand );
3937 if( nDdeErr )
3939 StarBASIC::Error( nDdeErr );
3943 void SbRtl_DDEPoke(StarBASIC *, SbxArray & rPar, bool)
3945 rPar.Get32(0)->PutEmpty();
3946 int nArgs = static_cast<int>(rPar.Count32());
3947 if ( nArgs != 4 )
3949 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3950 return;
3952 size_t nChannel = rPar.Get32(1)->GetInteger();
3953 const OUString& rItem = rPar.Get32(2)->GetOUString();
3954 const OUString& rData = rPar.Get32(3)->GetOUString();
3955 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3956 ErrCode nDdeErr = pDDE->Poke( nChannel, rItem, rData );
3957 if( nDdeErr )
3959 StarBASIC::Error( nDdeErr );
3964 void SbRtl_FreeFile(StarBASIC *, SbxArray & rPar, bool)
3966 if ( rPar.Count32() != 1 )
3968 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3969 return;
3971 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3972 short nChannel = 1;
3973 while( nChannel < CHANNELS )
3975 SbiStream* pStrm = pIO->GetStream( nChannel );
3976 if( !pStrm )
3978 rPar.Get32(0)->PutInteger( nChannel );
3979 return;
3981 nChannel++;
3983 StarBASIC::Error( ERRCODE_BASIC_TOO_MANY_FILES );
3986 void SbRtl_LBound(StarBASIC *, SbxArray & rPar, bool)
3988 const sal_uInt32 nParCount = rPar.Count32();
3989 if ( nParCount != 3 && nParCount != 2 )
3991 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3992 return;
3994 SbxBase* pParObj = rPar.Get32(1)->GetObject();
3995 SbxDimArray* pArr = dynamic_cast<SbxDimArray*>( pParObj );
3996 if( pArr )
3998 sal_Int32 nLower, nUpper;
3999 short nDim = (nParCount == 3) ? static_cast<short>(rPar.Get32(2)->GetInteger()) : 1;
4000 if( !pArr->GetDim32( nDim, nLower, nUpper ) )
4001 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
4002 else
4003 rPar.Get32(0)->PutLong( nLower );
4005 else
4006 StarBASIC::Error( ERRCODE_BASIC_MUST_HAVE_DIMS );
4009 void SbRtl_UBound(StarBASIC *, SbxArray & rPar, bool)
4011 const sal_uInt32 nParCount = rPar.Count32();
4012 if ( nParCount != 3 && nParCount != 2 )
4014 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4015 return;
4018 SbxBase* pParObj = rPar.Get32(1)->GetObject();
4019 SbxDimArray* pArr = dynamic_cast<SbxDimArray*>( pParObj );
4020 if( pArr )
4022 sal_Int32 nLower, nUpper;
4023 short nDim = (nParCount == 3) ? static_cast<short>(rPar.Get32(2)->GetInteger()) : 1;
4024 if( !pArr->GetDim32( nDim, nLower, nUpper ) )
4025 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
4026 else
4027 rPar.Get32(0)->PutLong( nUpper );
4029 else
4030 StarBASIC::Error( ERRCODE_BASIC_MUST_HAVE_DIMS );
4033 void SbRtl_RGB(StarBASIC *, SbxArray & rPar, bool)
4035 if ( rPar.Count32() != 4 )
4037 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4038 return;
4041 sal_Int32 nRed = rPar.Get32(1)->GetInteger() & 0xFF;
4042 sal_Int32 nGreen = rPar.Get32(2)->GetInteger() & 0xFF;
4043 sal_Int32 nBlue = rPar.Get32(3)->GetInteger() & 0xFF;
4044 sal_Int32 nRGB;
4046 SbiInstance* pInst = GetSbData()->pInst;
4047 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
4048 if( bCompatibility )
4050 nRGB = (nBlue << 16) | (nGreen << 8) | nRed;
4052 else
4054 nRGB = (nRed << 16) | (nGreen << 8) | nBlue;
4056 rPar.Get32(0)->PutLong( nRGB );
4059 void SbRtl_QBColor(StarBASIC *, SbxArray & rPar, bool)
4061 static const sal_Int32 pRGB[] =
4063 0x000000,
4064 0x800000,
4065 0x008000,
4066 0x808000,
4067 0x000080,
4068 0x800080,
4069 0x008080,
4070 0xC0C0C0,
4071 0x808080,
4072 0xFF0000,
4073 0x00FF00,
4074 0xFFFF00,
4075 0x0000FF,
4076 0xFF00FF,
4077 0x00FFFF,
4078 0xFFFFFF,
4081 if ( rPar.Count32() != 2 )
4083 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4084 return;
4087 sal_Int16 nCol = rPar.Get32(1)->GetInteger();
4088 if( nCol < 0 || nCol > 15 )
4090 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4091 return;
4093 sal_Int32 nRGB = pRGB[ nCol ];
4094 rPar.Get32(0)->PutLong( nRGB );
4097 // StrConv(string, conversion, LCID)
4098 void SbRtl_StrConv(StarBASIC *, SbxArray & rPar, bool)
4100 const sal_uInt32 nArgCount = rPar.Count32()-1;
4101 if( nArgCount < 2 || nArgCount > 3 )
4103 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4104 return;
4107 OUString aOldStr = rPar.Get32(1)->GetOUString();
4108 sal_Int32 nConversion = rPar.Get32(2)->GetLong();
4110 sal_Int32 nOldLen = aOldStr.getLength();
4111 if( nOldLen == 0 )
4113 // null string,return
4114 rPar.Get32(0)->PutString(aOldStr);
4115 return;
4118 TransliterationFlags nType = TransliterationFlags::NONE;
4119 if ( (nConversion & 0x03) == 3 ) // vbProperCase
4121 const CharClass& rCharClass = GetCharClass();
4122 aOldStr = rCharClass.titlecase( aOldStr.toAsciiLowerCase(), 0, nOldLen );
4124 else if ( (nConversion & 0x01) == 1 ) // vbUpperCase
4126 nType |= TransliterationFlags::LOWERCASE_UPPERCASE;
4128 else if ( (nConversion & 0x02) == 2 ) // vbLowerCase
4130 nType |= TransliterationFlags::UPPERCASE_LOWERCASE;
4132 if ( (nConversion & 0x04) == 4 ) // vbWide
4134 nType |= TransliterationFlags::HALFWIDTH_FULLWIDTH;
4136 else if ( (nConversion & 0x08) == 8 ) // vbNarrow
4138 nType |= TransliterationFlags::FULLWIDTH_HALFWIDTH;
4140 if ( (nConversion & 0x10) == 16) // vbKatakana
4142 nType |= TransliterationFlags::HIRAGANA_KATAKANA;
4144 else if ( (nConversion & 0x20) == 32 ) // vbHiragana
4146 nType |= TransliterationFlags::KATAKANA_HIRAGANA;
4148 OUString aNewStr( aOldStr );
4149 if( nType != TransliterationFlags::NONE )
4151 uno::Reference< uno::XComponentContext > xContext = getProcessComponentContext();
4152 ::utl::TransliterationWrapper aTransliterationWrapper( xContext, nType );
4153 uno::Sequence<sal_Int32> aOffsets;
4154 LanguageType nLanguage = LANGUAGE_SYSTEM;
4155 aTransliterationWrapper.loadModuleIfNeeded( nLanguage );
4156 aNewStr = aTransliterationWrapper.transliterate( aOldStr, nLanguage, 0, nOldLen, &aOffsets );
4159 if ( (nConversion & 0x40) == 64 ) // vbUnicode
4161 // convert the string to byte string, preserving unicode (2 bytes per character)
4162 sal_Int32 nSize = aNewStr.getLength()*2;
4163 const sal_Unicode* pSrc = aNewStr.getStr();
4164 std::unique_ptr<char[]> pChar(new char[nSize+1]);
4165 for( sal_Int32 i=0; i < nSize; i++ )
4167 pChar[i] = static_cast< char >( (i%2) ? ((*pSrc) >> 8) & 0xff : (*pSrc) & 0xff );
4168 if( i%2 )
4170 pSrc++;
4173 pChar[nSize] = '\0';
4174 OString aOStr(pChar.get());
4176 // there is no concept about default codepage in unix. so it is incorrectly in unix
4177 OUString aOUStr = OStringToOUString(aOStr, osl_getThreadTextEncoding());
4178 rPar.Get32(0)->PutString( aOUStr );
4179 return;
4181 else if ( (nConversion & 0x80) == 128 ) // vbFromUnicode
4183 // there is no concept about default codepage in unix. so it is incorrectly in unix
4184 OString aOStr = OUStringToOString(aNewStr,osl_getThreadTextEncoding());
4185 const char* pChar = aOStr.getStr();
4186 sal_Int32 nArraySize = aOStr.getLength();
4187 SbxDimArray* pArray = new SbxDimArray(SbxBYTE);
4188 bool bIncIndex = IsBaseIndexOne();
4189 if(nArraySize)
4191 if( bIncIndex )
4193 pArray->AddDim32( 1, nArraySize );
4195 else
4197 pArray->AddDim32( 0, nArraySize-1 );
4200 else
4202 pArray->unoAddDim32( 0, -1 );
4205 for( sal_Int32 i=0; i< nArraySize; i++)
4207 SbxVariable* pNew = new SbxVariable( SbxBYTE );
4208 pNew->PutByte(*pChar);
4209 pChar++;
4210 pNew->SetFlag( SbxFlagBits::Write );
4211 sal_Int32 aIdx[1];
4212 aIdx[0] = i;
4213 if( bIncIndex )
4215 ++aIdx[0];
4217 pArray->Put32(pNew, aIdx);
4220 SbxVariableRef refVar = rPar.Get32(0);
4221 SbxFlagBits nFlags = refVar->GetFlags();
4222 refVar->ResetFlag( SbxFlagBits::Fixed );
4223 refVar->PutObject( pArray );
4224 refVar->SetFlags( nFlags );
4225 refVar->SetParameters( nullptr );
4226 return;
4228 rPar.Get32(0)->PutString(aNewStr);
4232 void SbRtl_Beep(StarBASIC *, SbxArray & rPar, bool)
4234 if ( rPar.Count32() != 1 )
4236 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4237 return;
4239 Sound::Beep();
4242 void SbRtl_Load(StarBASIC *, SbxArray & rPar, bool)
4244 if( rPar.Count32() != 2 )
4246 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4247 return;
4251 SbxBase* pObj = rPar.Get32(1)->GetObject();
4252 if ( !pObj )
4253 return;
4255 if (SbUserFormModule* pModule = dynamic_cast<SbUserFormModule*>(pObj))
4257 pModule->Load();
4259 else if (SbxObject* pSbxObj = dynamic_cast<SbxObject*>(pObj))
4261 SbxVariable* pVar = pSbxObj->Find("Load", SbxClassType::Method);
4262 if( pVar )
4264 pVar->GetInteger();
4269 void SbRtl_Unload(StarBASIC *, SbxArray & rPar, bool)
4271 rPar.Get32(0)->PutEmpty();
4272 if( rPar.Count32() != 2 )
4274 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4275 return;
4279 SbxBase* pObj = rPar.Get32(1)->GetObject();
4280 if ( !pObj )
4281 return;
4283 if (SbUserFormModule* pFormModule = dynamic_cast<SbUserFormModule*>(pObj))
4285 pFormModule->Unload();
4287 else if (SbxObject *pSbxObj = dynamic_cast<SbxObject*>(pObj))
4289 SbxVariable* pVar = pSbxObj->Find("Unload", SbxClassType::Method);
4290 if( pVar )
4292 pVar->GetInteger();
4297 void SbRtl_LoadPicture(StarBASIC *, SbxArray & rPar, bool)
4299 if( rPar.Count32() != 2 )
4301 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4302 return;
4305 OUString aFileURL = getFullPath( rPar.Get32(1)->GetOUString() );
4306 std::unique_ptr<SvStream> pStream(utl::UcbStreamHelper::CreateStream( aFileURL, StreamMode::READ ));
4307 if( pStream )
4309 Bitmap aBmp;
4310 ReadDIB(aBmp, *pStream, true);
4311 BitmapEx aBitmapEx(aBmp);
4312 Graphic aGraphic(aBitmapEx);
4314 SbxObjectRef xRef = new SbStdPicture;
4315 static_cast<SbStdPicture*>(xRef.get())->SetGraphic( aGraphic );
4316 rPar.Get32(0)->PutObject( xRef.get() );
4320 void SbRtl_SavePicture(StarBASIC *, SbxArray & rPar, bool)
4322 rPar.Get32(0)->PutEmpty();
4323 if( rPar.Count32() != 3 )
4325 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4326 return;
4329 SbxBase* pObj = rPar.Get32(1)->GetObject();
4330 if (SbStdPicture *pPicture = dynamic_cast<SbStdPicture*>(pObj))
4332 SvFileStream aOStream( rPar.Get32(2)->GetOUString(), StreamMode::WRITE | StreamMode::TRUNC );
4333 const Graphic& aGraphic = pPicture->GetGraphic();
4334 WriteGraphic( aOStream, aGraphic );
4338 void SbRtl_MsgBox(StarBASIC *, SbxArray & rPar, bool)
4340 const sal_uInt32 nArgCount = rPar.Count32();
4341 if( nArgCount < 2 || nArgCount > 6 )
4343 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4344 return;
4346 WinBits nType = 0; // MB_OK
4347 if( nArgCount >= 3 )
4348 nType = static_cast<WinBits>(rPar.Get32(2)->GetInteger());
4349 WinBits nStyle = nType;
4350 nStyle &= 15; // delete bits 4-16
4351 if (nStyle > 5)
4352 nStyle = 0;
4354 enum BasicResponse
4356 Ok = 1,
4357 Cancel = 2,
4358 Abort = 3,
4359 Retry = 4,
4360 Ignore = 5,
4361 Yes = 6,
4362 No = 7
4365 OUString aMsg = rPar.Get32(1)->GetOUString();
4366 OUString aTitle;
4367 if( nArgCount >= 4 )
4369 aTitle = rPar.Get32(3)->GetOUString();
4371 else
4373 aTitle = Application::GetDisplayName();
4376 WinBits nDialogType = nType & (16+32+64);
4378 SolarMutexGuard aSolarGuard;
4379 vcl::Window* pParentWin = Application::GetDefDialogParent();
4380 weld::Widget* pParent = pParentWin ? pParentWin->GetFrameWeld() : nullptr;
4382 VclMessageType eType = VclMessageType::Other;
4384 switch (nDialogType)
4386 case 16:
4387 eType = VclMessageType::Error;
4388 break;
4389 case 32:
4390 eType = VclMessageType::Question;
4391 break;
4392 case 48:
4393 eType = VclMessageType::Warning;
4394 break;
4395 case 64:
4396 eType = VclMessageType::Info;
4397 break;
4400 std::unique_ptr<weld::MessageDialog> xBox(Application::CreateMessageDialog(pParent,
4401 eType, VclButtonsType::NONE, aMsg));
4403 switch (nStyle)
4405 case 0: // MB_OK
4406 default:
4407 xBox->add_button(GetStandardText(StandardButtonType::OK), BasicResponse::Ok);
4408 break;
4409 case 1: // MB_OKCANCEL
4410 xBox->add_button(GetStandardText(StandardButtonType::OK), BasicResponse::Ok);
4411 xBox->add_button(GetStandardText(StandardButtonType::Cancel), BasicResponse::Cancel);
4413 if (nType & 256 || nType & 512)
4414 xBox->set_default_response(BasicResponse::Cancel);
4415 else
4416 xBox->set_default_response(BasicResponse::Ok);
4418 break;
4419 case 2: // MB_ABORTRETRYIGNORE
4420 xBox->add_button(GetStandardText(StandardButtonType::Abort), BasicResponse::Abort);
4421 xBox->add_button(GetStandardText(StandardButtonType::Retry), BasicResponse::Retry);
4422 xBox->add_button(GetStandardText(StandardButtonType::Ignore), BasicResponse::Ignore);
4424 if (nType & 256)
4425 xBox->set_default_response(BasicResponse::Retry);
4426 else if (nType & 512)
4427 xBox->set_default_response(BasicResponse::Ignore);
4428 else
4429 xBox->set_default_response(BasicResponse::Cancel);
4431 break;
4432 case 3: // MB_YESNOCANCEL
4433 xBox->add_button(GetStandardText(StandardButtonType::Yes), BasicResponse::Yes);
4434 xBox->add_button(GetStandardText(StandardButtonType::No), BasicResponse::No);
4435 xBox->add_button(GetStandardText(StandardButtonType::Cancel), BasicResponse::Cancel);
4437 if (nType & 256 || nType & 512)
4438 xBox->set_default_response(BasicResponse::Cancel);
4439 else
4440 xBox->set_default_response(BasicResponse::Yes);
4442 break;
4443 case 4: // MB_YESNO
4444 xBox->add_button(GetStandardText(StandardButtonType::Yes), BasicResponse::Yes);
4445 xBox->add_button(GetStandardText(StandardButtonType::No), BasicResponse::No);
4447 if (nType & 256 || nType & 512)
4448 xBox->set_default_response(BasicResponse::No);
4449 else
4450 xBox->set_default_response(BasicResponse::Yes);
4452 break;
4453 case 5: // MB_RETRYCANCEL
4454 xBox->add_button(GetStandardText(StandardButtonType::Retry), BasicResponse::Retry);
4455 xBox->add_button(GetStandardText(StandardButtonType::Cancel), BasicResponse::Cancel);
4457 if (nType & 256 || nType & 512)
4458 xBox->set_default_response(BasicResponse::Cancel);
4459 else
4460 xBox->set_default_response(BasicResponse::Retry);
4462 break;
4465 xBox->set_title(aTitle);
4466 sal_Int16 nRet = xBox->run();
4467 rPar.Get32(0)->PutInteger(nRet);
4470 void SbRtl_SetAttr(StarBASIC *, SbxArray & rPar, bool)
4472 rPar.Get32(0)->PutEmpty();
4473 if ( rPar.Count32() == 3 )
4475 OUString aStr = rPar.Get32(1)->GetOUString();
4476 SbAttributes nFlags = static_cast<SbAttributes>( rPar.Get32(2)->GetInteger() );
4478 if( hasUno() )
4480 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
4481 if( xSFI.is() )
4485 bool bReadOnly = bool(nFlags & SbAttributes::READONLY);
4486 xSFI->setReadOnly( aStr, bReadOnly );
4487 bool bHidden = bool(nFlags & SbAttributes::HIDDEN);
4488 xSFI->setHidden( aStr, bHidden );
4490 catch(const Exception & )
4492 StarBASIC::Error( ERRCODE_IO_GENERAL );
4497 else
4499 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4503 void SbRtl_Reset(StarBASIC *, SbxArray &, bool)
4505 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
4506 if (pIO)
4508 pIO->CloseAll();
4512 void SbRtl_DumpAllObjects(StarBASIC * pBasic, SbxArray & rPar, bool)
4514 const sal_uInt32 nArgCount = rPar.Count32();
4515 if( nArgCount < 2 || nArgCount > 3 )
4517 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4519 else if( !pBasic )
4521 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
4523 else
4525 SbxObject* p = pBasic;
4526 while( p->GetParent() )
4528 p = p->GetParent();
4530 SvFileStream aStrm( rPar.Get32(1)->GetOUString(),
4531 StreamMode::WRITE | StreamMode::TRUNC );
4532 p->Dump( aStrm, rPar.Get32(2)->GetBool() );
4533 aStrm.Close();
4534 if( aStrm.GetError() != ERRCODE_NONE )
4536 StarBASIC::Error( ERRCODE_BASIC_IO_ERROR );
4542 void SbRtl_FileExists(StarBASIC *, SbxArray & rPar, bool)
4544 if ( rPar.Count32() == 2 )
4546 OUString aStr = rPar.Get32(1)->GetOUString();
4547 bool bExists = false;
4549 if( hasUno() )
4551 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
4552 if( xSFI.is() )
4556 bExists = xSFI->exists( aStr );
4558 catch(const Exception & )
4560 StarBASIC::Error( ERRCODE_IO_GENERAL );
4564 else
4566 DirectoryItem aItem;
4567 FileBase::RC nRet = DirectoryItem::get( getFullPath( aStr ), aItem );
4568 bExists = (nRet == FileBase::E_None);
4570 rPar.Get32(0)->PutBool( bExists );
4572 else
4574 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4578 void SbRtl_Partition(StarBASIC *, SbxArray & rPar, bool)
4580 if ( rPar.Count32() != 5 )
4582 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4583 return;
4586 sal_Int32 nNumber = rPar.Get32(1)->GetLong();
4587 sal_Int32 nStart = rPar.Get32(2)->GetLong();
4588 sal_Int32 nStop = rPar.Get32(3)->GetLong();
4589 sal_Int32 nInterval = rPar.Get32(4)->GetLong();
4591 if( nStart < 0 || nStop <= nStart || nInterval < 1 )
4593 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4594 return;
4597 // the Partition function inserts leading spaces before lowervalue and uppervalue
4598 // so that they both have the same number of characters as the string
4599 // representation of the value (Stop + 1). This ensures that if you use the output
4600 // of the Partition function with several values of Number, the resulting text
4601 // will be handled properly during any subsequent sort operation.
4603 // calculate the maximum number of characters before lowervalue and uppervalue
4604 OUString aBeforeStart = OUString::number( nStart - 1 );
4605 OUString aAfterStop = OUString::number( nStop + 1 );
4606 sal_Int32 nLen1 = aBeforeStart.getLength();
4607 sal_Int32 nLen2 = aAfterStop.getLength();
4608 sal_Int32 nLen = nLen1 >= nLen2 ? nLen1:nLen2;
4610 OUStringBuffer aRetStr( nLen * 2 + 1);
4611 OUString aLowerValue;
4612 OUString aUpperValue;
4613 if( nNumber < nStart )
4615 aUpperValue = aBeforeStart;
4617 else if( nNumber > nStop )
4619 aLowerValue = aAfterStop;
4621 else
4623 sal_Int32 nLowerValue = nNumber;
4624 sal_Int32 nUpperValue = nLowerValue;
4625 if( nInterval > 1 )
4627 nLowerValue = ((( nNumber - nStart ) / nInterval ) * nInterval ) + nStart;
4628 nUpperValue = nLowerValue + nInterval - 1;
4630 aLowerValue = OUString::number( nLowerValue );
4631 aUpperValue = OUString::number( nUpperValue );
4634 nLen1 = aLowerValue.getLength();
4635 nLen2 = aUpperValue.getLength();
4637 if( nLen > nLen1 )
4639 // appending the leading spaces for the lowervalue
4640 for ( sal_Int32 i= nLen - nLen1; i > 0; --i )
4642 aRetStr.append(" ");
4645 aRetStr.append( aLowerValue ).append(":");
4646 if( nLen > nLen2 )
4648 // appending the leading spaces for the uppervalue
4649 for ( sal_Int32 i= nLen - nLen2; i > 0; --i )
4651 aRetStr.append(" ");
4654 aRetStr.append( aUpperValue );
4655 rPar.Get32(0)->PutString( aRetStr.makeStringAndClear());
4658 #endif
4660 static tools::Long GetDayDiff( const Date& rDate )
4662 Date aRefDate( 1,1,1900 );
4663 tools::Long nDiffDays;
4664 if ( aRefDate > rDate )
4666 nDiffDays = aRefDate - rDate;
4667 nDiffDays *= -1;
4669 else
4671 nDiffDays = rDate - aRefDate;
4673 nDiffDays += 2; // adjustment VisualBasic: 1.Jan.1900 == 2
4674 return nDiffDays;
4677 sal_Int16 implGetDateYear( double aDate )
4679 Date aRefDate( 1,1,1900 );
4680 tools::Long nDays = static_cast<tools::Long>(aDate);
4681 nDays -= 2; // standardize: 1.1.1900 => 0.0
4682 aRefDate.AddDays( nDays );
4683 sal_Int16 nRet = aRefDate.GetYear();
4684 return nRet;
4687 bool implDateSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay,
4688 bool bUseTwoDigitYear, SbDateCorrection eCorr, double& rdRet )
4690 // XXX NOTE: For VBA years<0 are invalid and years in the range 0..29 and
4691 // 30..99 can not be input as they are 2-digit for 2000..2029 and
4692 // 1930..1999, VBA mode overrides bUseTwoDigitYear (as if that was always
4693 // true). For VBA years > 9999 are invalid.
4694 // For StarBASIC, if bUseTwoDigitYear==true then years in the range 0..99
4695 // can not be input as they are 2-digit for 1900..1999, years<0 are
4696 // accepted. If bUseTwoDigitYear==false then all years are accepted, but
4697 // year 0 is invalid (last day BCE -0001-12-31, first day CE 0001-01-01).
4698 #if HAVE_FEATURE_SCRIPTING
4699 if ( (nYear < 0 || 9999 < nYear) && SbiRuntime::isVBAEnabled() )
4701 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4702 return false;
4704 else if ( nYear < 30 && SbiRuntime::isVBAEnabled() )
4706 nYear += 2000;
4708 else
4709 #endif
4711 if ( 0 <= nYear && nYear < 100 && (bUseTwoDigitYear
4712 #if HAVE_FEATURE_SCRIPTING
4713 || SbiRuntime::isVBAEnabled()
4714 #endif
4717 nYear += 1900;
4721 sal_Int32 nAddMonths = 0;
4722 sal_Int32 nAddDays = 0;
4723 // Always sanitize values to set date and to use for validity detection.
4724 if (nMonth < 1 || 12 < nMonth)
4726 sal_Int16 nM = ((nMonth < 1) ? (12 + (nMonth % 12)) : (nMonth % 12));
4727 nAddMonths = nMonth - nM;
4728 nMonth = nM;
4730 // Day 0 would already be normalized during Date::Normalize(), include
4731 // it in negative days, also to detect non-validity. The actual day of
4732 // month is 1+(nDay-1)
4733 if (nDay < 1)
4735 nAddDays = nDay - 1;
4736 nDay = 1;
4738 else if (nDay > 31)
4740 nAddDays = nDay - 31;
4741 nDay = 31;
4744 Date aCurDate( nDay, nMonth, nYear );
4746 /* TODO: we could enable the same rollover mechanism for StarBASIC to be
4747 * compatible with VBA (just with our wider supported date range), then
4748 * documentation would need to be adapted. As is, the DateSerial() runtime
4749 * function works as dumb as documented... (except that the resulting date
4750 * is checked for validity now and not just day<=31 and month<=12).
4751 * If change wanted then simply remove overriding RollOver here and adapt
4752 * documentation.*/
4753 #if HAVE_FEATURE_SCRIPTING
4754 if (eCorr == SbDateCorrection::RollOver && !SbiRuntime::isVBAEnabled())
4755 eCorr = SbDateCorrection::None;
4756 #endif
4758 if (nYear == 0 || (eCorr == SbDateCorrection::None && (nAddMonths || nAddDays || !aCurDate.IsValidDate())))
4760 #if HAVE_FEATURE_SCRIPTING
4761 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4762 #endif
4763 return false;
4766 if (eCorr != SbDateCorrection::None)
4768 aCurDate.Normalize();
4769 if (nAddMonths)
4770 aCurDate.AddMonths( nAddMonths);
4771 if (nAddDays)
4772 aCurDate.AddDays( nAddDays);
4773 if (eCorr == SbDateCorrection::TruncateToMonth && aCurDate.GetMonth() != nMonth)
4775 if (aCurDate.GetYear() == SAL_MAX_INT16 && nMonth == 12)
4777 // Roll over and back not possible, hard max.
4778 aCurDate.SetMonth(12);
4779 aCurDate.SetDay(31);
4781 else
4783 aCurDate.SetMonth(nMonth);
4784 aCurDate.SetDay(1);
4785 aCurDate.AddMonths(1);
4786 aCurDate.AddDays(-1);
4791 tools::Long nDiffDays = GetDayDiff( aCurDate );
4792 rdRet = static_cast<double>(nDiffDays);
4793 return true;
4796 double implTimeSerial( sal_Int16 nHours, sal_Int16 nMinutes, sal_Int16 nSeconds )
4798 return
4799 static_cast<double>( nHours * ::tools::Time::secondPerHour +
4800 nMinutes * ::tools::Time::secondPerMinute +
4801 nSeconds)
4803 static_cast<double>( ::tools::Time::secondPerDay );
4806 bool implDateTimeSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay,
4807 sal_Int16 nHour, sal_Int16 nMinute, sal_Int16 nSecond,
4808 double& rdRet )
4810 double dDate;
4811 if(!implDateSerial(nYear, nMonth, nDay, false/*bUseTwoDigitYear*/, SbDateCorrection::None, dDate))
4812 return false;
4813 rdRet += dDate + implTimeSerial(nHour, nMinute, nSecond);
4814 return true;
4817 sal_Int16 implGetMinute( double dDate )
4819 double nFrac = dDate - floor( dDate );
4820 nFrac *= 86400.0;
4821 sal_Int32 nSeconds = static_cast<sal_Int32>(nFrac + 0.5);
4822 sal_Int16 nTemp = static_cast<sal_Int16>(nSeconds % 3600);
4823 sal_Int16 nMin = nTemp / 60;
4824 return nMin;
4827 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */