1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
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>
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>
47 #include <runtime.hxx>
48 #include <sbunoobj.hxx>
49 #include <osl/file.hxx>
50 #include <errobject.hxx>
52 #include <comphelper/string.hxx>
53 #include <comphelper/processfactory.hxx>
55 #include <com/sun/star/uno/Sequence.hxx>
56 #include <com/sun/star/util/DateTime.hpp>
57 #include <com/sun/star/lang/Locale.hpp>
58 #include <com/sun/star/lang/XServiceInfo.hpp>
59 #include <com/sun/star/ucb/SimpleFileAccess.hpp>
60 #include <com/sun/star/script/XErrorQuery.hpp>
61 #include <ooo/vba/VbTriState.hpp>
62 #include <com/sun/star/bridge/oleautomation/XAutomationObject.hpp>
65 #include <o3tl/char16_t2wchar_t.hxx>
67 using namespace comphelper
;
69 using namespace com::sun::star
;
70 using namespace com::sun::star::lang
;
71 using namespace com::sun::star::uno
;
74 #include <sbstdobj.hxx>
75 #include <rtlproto.hxx>
78 #include "ddectrl.hxx"
79 #include <sbintern.hxx>
80 #include <basic/vbahelper.hxx>
88 #include <sbobjmod.hxx>
100 #if HAVE_FEATURE_SCRIPTING
102 static void FilterWhiteSpace( OUString
& rStr
)
110 for (sal_Int32 i
= 0; i
< rStr
.getLength(); ++i
)
112 sal_Unicode cChar
= rStr
[i
];
113 if ((cChar
!= ' ') && (cChar
!= '\t') &&
114 (cChar
!= '\n') && (cChar
!= '\r'))
120 rStr
= aRet
.makeStringAndClear();
123 static long GetDayDiff( const Date
& rDate
);
125 static const CharClass
& GetCharClass()
127 static CharClass
aCharClass( Application::GetSettings().GetLanguageTag() );
131 static bool isFolder( FileStatus::Type aType
)
133 return ( aType
== FileStatus::Directory
|| aType
== FileStatus::Volume
);
137 //*** UCB file access ***
139 // Converts possibly relative paths to absolute paths
140 // according to the setting done by ChDir/ChDrive
141 OUString
getFullPath( const OUString
& aRelPath
)
145 // #80204 Try first if it already is a valid URL
146 INetURLObject
aURLObj( aRelPath
);
147 aFileURL
= aURLObj
.GetMainURL( INetURLObject::DecodeMechanism::NONE
);
149 if( aFileURL
.isEmpty() )
151 File::getFileURLFromSystemPath( aRelPath
, aFileURL
);
157 // TODO: -> SbiGlobals
158 static uno::Reference
< ucb::XSimpleFileAccess3
> const & getFileAccess()
160 static uno::Reference
< ucb::XSimpleFileAccess3
> xSFI
= ucb::SimpleFileAccess::create( comphelper::getProcessComponentContext() );
165 // Properties and methods lie down the return value at the Get (bPut = sal_False) in the
166 // element 0 of the Argv; the value of element 0 is saved at Put (bPut = sal_True)
168 // CreateObject( class )
170 void SbRtl_CreateObject(StarBASIC
* pBasic
, SbxArray
& rPar
, bool)
172 OUString
aClass( rPar
.Get( 1 )->GetOUString() );
173 SbxObjectRef p
= SbxBase::CreateObject( aClass
);
175 StarBASIC::Error( ERRCODE_BASIC_CANNOT_LOAD
);
178 // Convenience: enter BASIC as parent
179 p
->SetParent( pBasic
);
180 rPar
.Get( 0 )->PutObject( p
.get() );
186 void SbRtl_Error(StarBASIC
* pBasic
, SbxArray
& rPar
, bool)
189 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR
);
193 ErrCode nErr
= ERRCODE_NONE
;
195 if( rPar
.Count() == 1 )
197 nErr
= StarBASIC::GetErrBasic();
198 aErrorMsg
= StarBASIC::GetErrorMsg();
202 nCode
= rPar
.Get( 1 )->GetLong();
205 StarBASIC::Error( ERRCODE_BASIC_CONVERSION
);
209 nErr
= StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16
>(nCode
) );
213 bool bVBA
= SbiRuntime::isVBAEnabled();
215 if( bVBA
&& !aErrorMsg
.isEmpty())
217 tmpErrMsg
= aErrorMsg
;
221 StarBASIC::MakeErrorText( nErr
, aErrorMsg
);
222 tmpErrMsg
= StarBASIC::GetErrorText();
224 // If this rtlfunc 'Error' passed an errcode the same as the active Err Objects's
225 // current err then return the description for the error message if it is set
226 // ( complicated isn't it ? )
227 if ( bVBA
&& rPar
.Count() > 1 )
229 uno::Reference
< ooo::vba::XErrObject
> xErrObj( SbxErrObject::getUnoErrObject() );
230 if ( xErrObj
.is() && xErrObj
->getNumber() == nCode
&& !xErrObj
->getDescription().isEmpty() )
232 tmpErrMsg
= xErrObj
->getDescription();
235 rPar
.Get( 0 )->PutString( tmpErrMsg
);
241 void SbRtl_Sin(StarBASIC
*, SbxArray
& rPar
, bool)
243 if ( rPar
.Count() < 2 )
244 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
247 SbxVariableRef pArg
= rPar
.Get( 1 );
248 rPar
.Get( 0 )->PutDouble( sin( pArg
->GetDouble() ) );
253 void SbRtl_Cos(StarBASIC
*, SbxArray
& rPar
, bool)
255 if ( rPar
.Count() < 2 )
256 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
259 SbxVariableRef pArg
= rPar
.Get( 1 );
260 rPar
.Get( 0 )->PutDouble( cos( pArg
->GetDouble() ) );
265 void SbRtl_Atn(StarBASIC
*, SbxArray
& rPar
, bool)
267 if ( rPar
.Count() < 2 )
268 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
271 SbxVariableRef pArg
= rPar
.Get( 1 );
272 rPar
.Get( 0 )->PutDouble( atan( pArg
->GetDouble() ) );
277 void SbRtl_Abs(StarBASIC
*, SbxArray
& rPar
, bool)
279 if ( rPar
.Count() < 2 )
281 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
285 SbxVariableRef pArg
= rPar
.Get( 1 );
286 rPar
.Get( 0 )->PutDouble( fabs( pArg
->GetDouble() ) );
291 void SbRtl_Asc(StarBASIC
*, SbxArray
& rPar
, bool)
293 if ( rPar
.Count() < 2 )
295 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
299 SbxVariableRef pArg
= rPar
.Get( 1 );
300 OUString
aStr( pArg
->GetOUString() );
303 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
304 rPar
.Get(0)->PutEmpty();
308 sal_Unicode aCh
= aStr
[0];
309 rPar
.Get(0)->PutLong( aCh
);
314 static void implChr( SbxArray
& rPar
, bool bChrW
)
316 if ( rPar
.Count() < 2 )
318 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
322 SbxVariableRef pArg
= rPar
.Get( 1 );
325 if( !bChrW
&& SbiRuntime::isVBAEnabled() )
327 sal_Char c
= static_cast<sal_Char
>(pArg
->GetByte());
328 aStr
= OUString(&c
, 1, osl_getThreadTextEncoding());
332 sal_Unicode aCh
= static_cast<sal_Unicode
>(pArg
->GetUShort());
333 aStr
= OUString(aCh
);
335 rPar
.Get(0)->PutString( aStr
);
339 void SbRtl_Chr(StarBASIC
*, SbxArray
& rPar
, bool)
341 implChr( rPar
, false/*bChrW*/ );
344 void SbRtl_ChrW(StarBASIC
*, SbxArray
& rPar
, bool)
346 implChr( rPar
, true/*bChrW*/ );
353 extern "C" void invalidParameterHandler(
354 wchar_t const * expression
, wchar_t const * function
, wchar_t const * file
, unsigned int line
,
359 "invalid parameter during _wgetdcwd; \"" << (expression
? o3tl::toU(expression
) : u
"???")
360 << "\" (" << (function
? o3tl::toU(function
) : u
"???") << ") at "
361 << (file
? o3tl::toU(file
) : u
"???") << ":" << line
);
368 void SbRtl_CurDir(StarBASIC
* pBasic
, SbxArray
& rPar
, bool bWrite
)
373 // #57064 Although this function doesn't work with DirEntry, it isn't touched
374 // by the adjustment to virtual URLs, as, using the DirEntry-functionality,
375 // there's no possibility to detect the current one in a way that a virtual URL
376 // could be delivered.
379 int nCurDir
= 0; // Current dir // JSM
380 if ( rPar
.Count() == 2 )
382 OUString aDrive
= rPar
.Get(1)->GetOUString();
383 if ( aDrive
.getLength() != 1 )
385 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
388 auto c
= rtl::toAsciiUpperCase(aDrive
[0]);
389 if ( !rtl::isAsciiUpperCase( c
) )
391 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
394 nCurDir
= c
- 'A' + 1;
396 wchar_t pBuffer
[ _MAX_PATH
];
397 // _wgetdcwd calls the C runtime's invalid parameter handler (which by default terminates the
398 // process) if nCurDir does not correspond to an existing drive, so temporarily set a "harmless"
400 auto const handler
= _set_thread_local_invalid_parameter_handler(&invalidParameterHandler
);
401 auto const ok
= _wgetdcwd( nCurDir
, pBuffer
, _MAX_PATH
) != nullptr;
402 _set_thread_local_invalid_parameter_handler(handler
);
405 rPar
.Get(0)->PutString( o3tl::toU(pBuffer
) );
409 StarBASIC::Error( ERRCODE_BASIC_NO_DEVICE
);
414 const int PATH_INCR
= 250;
416 int nSize
= PATH_INCR
;
417 std::unique_ptr
<char[]> pMem
;
420 pMem
.reset(new char[nSize
]);
423 StarBASIC::Error( ERRCODE_BASIC_NO_MEMORY
);
426 if( getcwd( pMem
.get(), nSize
-1 ) != nullptr )
428 rPar
.Get(0)->PutString( OUString::createFromAscii(pMem
.get()) );
431 if( errno
!= ERANGE
)
433 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR
);
442 void SbRtl_ChDir(StarBASIC
* pBasic
, SbxArray
& rPar
, bool)
444 rPar
.Get(0)->PutEmpty();
445 if (rPar
.Count() == 2)
447 // VBA: track current directory per document type (separately for Writer, Calc, Impress, etc.)
448 if( SbiRuntime::isVBAEnabled() )
450 ::basic::vba::registerCurrentDirectory( getDocumentModel( pBasic
), rPar
.Get(1)->GetOUString() );
455 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
459 void SbRtl_ChDrive(StarBASIC
*, SbxArray
& rPar
, bool)
461 rPar
.Get(0)->PutEmpty();
462 if (rPar
.Count() != 2)
464 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
469 // Implementation of StepRENAME with UCB
470 void implStepRenameUCB( const OUString
& aSource
, const OUString
& aDest
)
472 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
477 OUString aSourceFullPath
= getFullPath( aSource
);
478 if( !xSFI
->exists( aSourceFullPath
) )
480 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND
);
484 OUString aDestFullPath
= getFullPath( aDest
);
485 if( xSFI
->exists( aDestFullPath
) )
487 StarBASIC::Error( ERRCODE_BASIC_FILE_EXISTS
);
491 xSFI
->move( aSourceFullPath
, aDestFullPath
);
494 catch(const Exception
& )
496 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND
);
501 // Implementation of StepRENAME with OSL
502 void implStepRenameOSL( const OUString
& aSource
, const OUString
& aDest
)
504 FileBase::RC nRet
= File::move( getFullPath( aSource
), getFullPath( aDest
) );
505 if( nRet
!= FileBase::E_None
)
507 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND
);
511 void SbRtl_FileCopy(StarBASIC
*, SbxArray
& rPar
, bool)
513 rPar
.Get(0)->PutEmpty();
514 if (rPar
.Count() == 3)
516 OUString aSource
= rPar
.Get(1)->GetOUString();
517 OUString aDest
= rPar
.Get(2)->GetOUString();
520 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
525 xSFI
->copy( getFullPath( aSource
), getFullPath( aDest
) );
527 catch(const Exception
& )
529 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND
);
535 FileBase::RC nRet
= File::copy( getFullPath( aSource
), getFullPath( aDest
) );
536 if( nRet
!= FileBase::E_None
)
538 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND
);
543 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
546 void SbRtl_Kill(StarBASIC
*, SbxArray
& rPar
, bool)
548 rPar
.Get(0)->PutEmpty();
549 if (rPar
.Count() == 2)
551 OUString aFileSpec
= rPar
.Get(1)->GetOUString();
555 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
558 OUString aFullPath
= getFullPath( aFileSpec
);
559 if( !xSFI
->exists( aFullPath
) || xSFI
->isFolder( aFullPath
) )
561 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND
);
566 xSFI
->kill( aFullPath
);
568 catch(const Exception
& )
570 StarBASIC::Error( ERRCODE_IO_GENERAL
);
576 File::remove( getFullPath( aFileSpec
) );
581 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
585 void SbRtl_MkDir(StarBASIC
* pBasic
, SbxArray
& rPar
, bool bWrite
)
587 rPar
.Get(0)->PutEmpty();
588 if (rPar
.Count() == 2)
590 OUString aPath
= rPar
.Get(1)->GetOUString();
591 if ( SbiRuntime::isVBAEnabled() )
593 // In vba if the full path is not specified then
594 // folder is created relative to the curdir
595 INetURLObject
aURLObj( getFullPath( aPath
) );
596 if ( aURLObj
.GetProtocol() != INetProtocol::File
)
598 SbxArrayRef pPar
= new SbxArray();
599 SbxVariableRef pResult
= new SbxVariable();
600 SbxVariableRef pParam
= new SbxVariable();
601 pPar
->Insert( pResult
.get(), pPar
->Count() );
602 pPar
->Insert( pParam
.get(), pPar
->Count() );
603 SbRtl_CurDir( pBasic
, *pPar
, bWrite
);
605 OUString sCurPathURL
;
606 File::getFileURLFromSystemPath( pPar
->Get(0)->GetOUString(), sCurPathURL
);
608 aURLObj
.SetURL( sCurPathURL
);
609 aURLObj
.Append( aPath
);
610 File::getSystemPathFromFileURL(aURLObj
.GetMainURL( INetURLObject::DecodeMechanism::ToIUri
),aPath
) ;
616 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
621 xSFI
->createFolder( getFullPath( aPath
) );
623 catch(const Exception
& )
625 StarBASIC::Error( ERRCODE_IO_GENERAL
);
631 Directory::create( getFullPath( aPath
) );
636 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
641 // In OSL only empty directories can be deleted
642 // so we have to delete all files recursively
643 static void implRemoveDirRecursive( const OUString
& aDirPath
)
646 FileBase::RC nRet
= DirectoryItem::get( aDirPath
, aItem
);
647 bool bExists
= (nRet
== FileBase::E_None
);
649 FileStatus
aFileStatus( osl_FileStatus_Mask_Type
);
650 nRet
= aItem
.getFileStatus( aFileStatus
);
651 bool bFolder
= nRet
== FileBase::E_None
652 && isFolder( aFileStatus
.getFileType() );
654 if( !bExists
|| !bFolder
)
656 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND
);
660 Directory
aDir( aDirPath
);
662 if( nRet
!= FileBase::E_None
)
664 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND
);
670 DirectoryItem aItem2
;
671 nRet
= aDir
.getNextItem( aItem2
);
672 if( nRet
!= FileBase::E_None
)
677 FileStatus
aFileStatus2( osl_FileStatus_Mask_Type
| osl_FileStatus_Mask_FileURL
);
678 nRet
= aItem2
.getFileStatus( aFileStatus2
);
679 if( nRet
!= FileBase::E_None
)
681 SAL_WARN("basic", "getFileStatus failed");
684 OUString aPath
= aFileStatus2
.getFileURL();
687 FileStatus::Type aType2
= aFileStatus2
.getFileType();
688 bool bFolder2
= isFolder( aType2
);
691 implRemoveDirRecursive( aPath
);
695 File::remove( aPath
);
700 Directory::remove( aDirPath
);
704 void SbRtl_RmDir(StarBASIC
*, SbxArray
& rPar
, bool)
706 rPar
.Get(0)->PutEmpty();
707 if (rPar
.Count() == 2)
709 OUString aPath
= rPar
.Get(1)->GetOUString();
712 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
717 if( !xSFI
->isFolder( aPath
) )
719 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND
);
722 SbiInstance
* pInst
= GetSbData()->pInst
;
723 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
726 Sequence
< OUString
> aContent
= xSFI
->getFolderContents( aPath
, true );
727 if( aContent
.hasElements() )
729 StarBASIC::Error( ERRCODE_BASIC_ACCESS_ERROR
);
734 xSFI
->kill( getFullPath( aPath
) );
736 catch(const Exception
& )
738 StarBASIC::Error( ERRCODE_IO_GENERAL
);
744 implRemoveDirRecursive( getFullPath( aPath
) );
749 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
753 void SbRtl_SendKeys(StarBASIC
*, SbxArray
& rPar
, bool)
755 rPar
.Get(0)->PutEmpty();
756 StarBASIC::Error(ERRCODE_BASIC_NOT_IMPLEMENTED
);
759 void SbRtl_Exp(StarBASIC
*, SbxArray
& rPar
, bool)
761 if( rPar
.Count() < 2 )
762 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
765 double aDouble
= rPar
.Get( 1 )->GetDouble();
766 aDouble
= exp( aDouble
);
767 checkArithmeticOverflow( aDouble
);
768 rPar
.Get( 0 )->PutDouble( aDouble
);
772 void SbRtl_FileLen(StarBASIC
*, SbxArray
& rPar
, bool)
774 if ( rPar
.Count() < 2 )
776 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
780 SbxVariableRef pArg
= rPar
.Get( 1 );
781 OUString
aStr( pArg
->GetOUString() );
785 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
790 nLen
= xSFI
->getSize( getFullPath( aStr
) );
792 catch(const Exception
& )
794 StarBASIC::Error( ERRCODE_IO_GENERAL
);
801 (void)DirectoryItem::get( getFullPath( aStr
), aItem
);
802 FileStatus
aFileStatus( osl_FileStatus_Mask_FileSize
);
803 (void)aItem
.getFileStatus( aFileStatus
);
804 nLen
= static_cast<sal_Int32
>(aFileStatus
.getFileSize());
806 rPar
.Get(0)->PutLong( static_cast<long>(nLen
) );
811 void SbRtl_Hex(StarBASIC
*, SbxArray
& rPar
, bool)
813 if ( rPar
.Count() < 2 )
815 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
819 SbxVariableRef pArg
= rPar
.Get( 1 );
820 // converting value to unsigned and limit to 2 or 4 byte representation
821 sal_uInt32 nVal
= pArg
->IsInteger() ?
822 static_cast<sal_uInt16
>(pArg
->GetInteger()) :
823 static_cast<sal_uInt32
>(pArg
->GetLong());
824 OUString
aStr(OUString::number( nVal
, 16 ));
825 aStr
= aStr
.toAsciiUpperCase();
826 rPar
.Get(0)->PutString( aStr
);
830 void SbRtl_FuncCaller(StarBASIC
*, SbxArray
& rPar
, bool)
832 if ( SbiRuntime::isVBAEnabled() && GetSbData()->pInst
&& GetSbData()->pInst
->pRun
)
834 if ( GetSbData()->pInst
->pRun
->GetExternalCaller() )
835 *rPar
.Get(0) = *GetSbData()->pInst
->pRun
->GetExternalCaller();
838 SbxVariableRef pVar
= new SbxVariable(SbxVARIANT
);
839 *rPar
.Get(0) = *pVar
;
844 StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED
);
848 // InStr( [start],string,string,[compare] )
850 void SbRtl_InStr(StarBASIC
*, SbxArray
& rPar
, bool)
852 std::size_t nArgCount
= rPar
.Count()-1;
854 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
857 sal_Int32 nStartPos
= 1;
858 sal_Int32 nFirstStringPos
= 1;
860 if ( nArgCount
>= 3 )
862 nStartPos
= rPar
.Get(1)->GetLong();
865 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
871 SbiInstance
* pInst
= GetSbData()->pInst
;
873 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
876 SbiRuntime
* pRT
= pInst
->pRun
;
877 bTextMode
= pRT
&& pRT
->IsImageFlag( SbiImageFlags::COMPARETEXT
);
883 if ( nArgCount
== 4 )
885 bTextMode
= rPar
.Get(4)->GetInteger();
888 const OUString
& rToken
= rPar
.Get(nFirstStringPos
+1)->GetOUString();
890 // #97545 Always find empty string
891 if( rToken
.isEmpty() )
899 const OUString
& rStr1
= rPar
.Get(nFirstStringPos
)->GetOUString();
900 nPos
= rStr1
.indexOf( rToken
, nStartPos
- 1 ) + 1;
904 OUString aStr1
= rPar
.Get(nFirstStringPos
)->GetOUString();
905 OUString aToken
= rToken
;
907 aStr1
= aStr1
.toAsciiUpperCase();
908 aToken
= aToken
.toAsciiUpperCase();
910 nPos
= aStr1
.indexOf( aToken
, nStartPos
-1 ) + 1;
913 rPar
.Get(0)->PutLong( nPos
);
918 // InstrRev(string1, string2[, start[, compare]])
920 void SbRtl_InStrRev(StarBASIC
*, SbxArray
& rPar
, bool)
922 std::size_t nArgCount
= rPar
.Count()-1;
925 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
929 OUString aStr1
= rPar
.Get(1)->GetOUString();
930 OUString aToken
= rPar
.Get(2)->GetOUString();
932 sal_Int32 nStartPos
= -1;
933 if ( nArgCount
>= 3 )
935 nStartPos
= rPar
.Get(3)->GetLong();
936 if( nStartPos
<= 0 && nStartPos
!= -1 )
938 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
943 SbiInstance
* pInst
= GetSbData()->pInst
;
945 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
948 SbiRuntime
* pRT
= pInst
->pRun
;
949 bTextMode
= pRT
&& pRT
->IsImageFlag( SbiImageFlags::COMPARETEXT
);
955 if ( nArgCount
== 4 )
957 bTextMode
= rPar
.Get(4)->GetInteger();
959 sal_Int32 nStrLen
= aStr1
.getLength();
960 if( nStartPos
== -1 )
966 if( nStartPos
<= nStrLen
)
968 sal_Int32 nTokenLen
= aToken
.getLength();
971 // Always find empty string
974 else if( nStrLen
> 0 )
978 nPos
= aStr1
.lastIndexOf( aToken
, nStartPos
) + 1;
982 aStr1
= aStr1
.toAsciiUpperCase();
983 aToken
= aToken
.toAsciiUpperCase();
985 nPos
= aStr1
.lastIndexOf( aToken
, nStartPos
) + 1;
989 rPar
.Get(0)->PutLong( nPos
);
998 Fix( -2.8 ) = -2.0 <- !!
1001 void SbRtl_Int(StarBASIC
*, SbxArray
& rPar
, bool)
1003 if ( rPar
.Count() < 2 )
1004 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1007 SbxVariableRef pArg
= rPar
.Get( 1 );
1008 double aDouble
= pArg
->GetDouble();
1011 floor( -2.8 ) = -3.0
1013 aDouble
= floor( aDouble
);
1014 rPar
.Get(0)->PutDouble( aDouble
);
1019 void SbRtl_Fix(StarBASIC
*, SbxArray
& rPar
, bool)
1021 if ( rPar
.Count() < 2 )
1022 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1025 SbxVariableRef pArg
= rPar
.Get( 1 );
1026 double aDouble
= pArg
->GetDouble();
1027 if ( aDouble
>= 0.0 )
1028 aDouble
= floor( aDouble
);
1030 aDouble
= ceil( aDouble
);
1031 rPar
.Get(0)->PutDouble( aDouble
);
1036 void SbRtl_LCase(StarBASIC
*, SbxArray
& rPar
, bool)
1038 if ( rPar
.Count() < 2 )
1040 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1044 const CharClass
& rCharClass
= GetCharClass();
1045 OUString
aStr( rPar
.Get(1)->GetOUString() );
1046 aStr
= rCharClass
.lowercase(aStr
);
1047 rPar
.Get(0)->PutString( aStr
);
1051 void SbRtl_Left(StarBASIC
*, SbxArray
& rPar
, bool)
1053 if ( rPar
.Count() < 3 )
1055 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1059 OUString
aStr( rPar
.Get(1)->GetOUString() );
1060 sal_Int32 nResultLen
= rPar
.Get(2)->GetLong();
1061 if( nResultLen
< 0 )
1064 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1066 else if(nResultLen
> aStr
.getLength())
1068 nResultLen
= aStr
.getLength();
1070 aStr
= aStr
.copy(0, nResultLen
);
1071 rPar
.Get(0)->PutString( aStr
);
1075 void SbRtl_Log(StarBASIC
*, SbxArray
& rPar
, bool)
1077 if ( rPar
.Count() < 2 )
1079 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1083 double aArg
= rPar
.Get(1)->GetDouble();
1086 double d
= log( aArg
);
1087 checkArithmeticOverflow( d
);
1088 rPar
.Get( 0 )->PutDouble( d
);
1092 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1097 void SbRtl_LTrim(StarBASIC
*, SbxArray
& rPar
, bool)
1099 if ( rPar
.Count() < 2 )
1101 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1105 OUString
aStr(comphelper::string::stripStart(rPar
.Get(1)->GetOUString(), ' '));
1106 rPar
.Get(0)->PutString(aStr
);
1111 // Mid( String, nStart, nLength )
1113 void SbRtl_Mid(StarBASIC
*, SbxArray
& rPar
, bool bWrite
)
1115 int nArgCount
= rPar
.Count()-1;
1116 if ( nArgCount
< 2 )
1118 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1122 // #23178: replicate the functionality of Mid$ as a command
1123 // by adding a replacement-string as a fourth parameter.
1124 // In contrast to the original the third parameter (nLength)
1125 // can't be left out here. That's considered in bWrite already.
1126 if( nArgCount
== 4 )
1130 OUString aArgStr
= rPar
.Get(1)->GetOUString();
1131 sal_Int32 nStartPos
= rPar
.Get(2)->GetLong();
1132 if ( nStartPos
< 1 )
1134 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1139 sal_Int32 nLen
= -1;
1140 bool bWriteNoLenParam
= false;
1141 if ( nArgCount
== 3 || bWrite
)
1143 sal_Int32 n
= rPar
.Get(3)->GetLong();
1144 if( bWrite
&& n
== -1 )
1146 bWriteNoLenParam
= true;
1152 sal_Int32 nArgLen
= aArgStr
.getLength();
1153 if( nStartPos
> nArgLen
)
1155 SbiInstance
* pInst
= GetSbData()->pInst
;
1156 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
1157 if( bCompatibility
)
1159 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1162 nStartPos
= nArgLen
;
1165 OUString aReplaceStr
= rPar
.Get(4)->GetOUString();
1166 sal_Int32 nReplaceStrLen
= aReplaceStr
.getLength();
1167 sal_Int32 nReplaceLen
;
1168 if( bWriteNoLenParam
)
1170 nReplaceLen
= nArgLen
- nStartPos
;
1175 if( nReplaceLen
< 0 || nReplaceLen
> nArgLen
- nStartPos
)
1177 nReplaceLen
= nArgLen
- nStartPos
;
1181 OUStringBuffer aResultStr
= aArgStr
;
1182 sal_Int32 nErase
= nReplaceLen
;
1183 aResultStr
.remove( nStartPos
, nErase
);
1185 nStartPos
, aReplaceStr
.getStr(), std::min(nReplaceLen
, nReplaceStrLen
));
1187 rPar
.Get(1)->PutString( aResultStr
.makeStringAndClear() );
1191 OUString aResultStr
;
1192 if (nStartPos
> aArgStr
.getLength())
1196 else if(nArgCount
== 2)
1198 aResultStr
= aArgStr
.copy( nStartPos
);
1204 if(nStartPos
+ nLen
> aArgStr
.getLength())
1206 nLen
= aArgStr
.getLength() - nStartPos
;
1209 aResultStr
= aArgStr
.copy( nStartPos
, nLen
);
1211 rPar
.Get(0)->PutString( aResultStr
);
1217 void SbRtl_Oct(StarBASIC
*, SbxArray
& rPar
, bool)
1219 if ( rPar
.Count() < 2 )
1221 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1226 SbxVariableRef pArg
= rPar
.Get( 1 );
1227 if ( pArg
->IsInteger() )
1229 snprintf( aBuffer
, sizeof(aBuffer
), "%o", pArg
->GetInteger() );
1233 snprintf( aBuffer
, sizeof(aBuffer
), "%lo", static_cast<long unsigned int>(pArg
->GetLong()) );
1235 rPar
.Get(0)->PutString( OUString::createFromAscii( aBuffer
) );
1239 // Replace(expression, find, replace[, start[, count[, compare]]])
1241 void SbRtl_Replace(StarBASIC
*, SbxArray
& rPar
, bool)
1243 std::size_t nArgCount
= rPar
.Count()-1;
1244 if ( nArgCount
< 3 || nArgCount
> 6 )
1246 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1250 OUString aExpStr
= rPar
.Get(1)->GetOUString();
1251 OUString aFindStr
= rPar
.Get(2)->GetOUString();
1252 OUString aReplaceStr
= rPar
.Get(3)->GetOUString();
1254 sal_Int32 lStartPos
= 1;
1255 if ( nArgCount
>= 4 )
1257 if( rPar
.Get(4)->GetType() != SbxEMPTY
)
1259 lStartPos
= rPar
.Get(4)->GetLong();
1263 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1268 sal_Int32 lCount
= -1;
1271 if( rPar
.Get(5)->GetType() != SbxEMPTY
)
1273 lCount
= rPar
.Get(5)->GetLong();
1277 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1282 SbiInstance
* pInst
= GetSbData()->pInst
;
1284 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
1285 if( bCompatibility
)
1287 SbiRuntime
* pRT
= pInst
->pRun
;
1288 bTextMode
= pRT
&& pRT
->IsImageFlag( SbiImageFlags::COMPARETEXT
);
1294 if ( nArgCount
== 6 )
1296 bTextMode
= rPar
.Get(6)->GetInteger();
1298 sal_Int32 nExpStrLen
= aExpStr
.getLength();
1299 sal_Int32 nFindStrLen
= aFindStr
.getLength();
1300 sal_Int32 nReplaceStrLen
= aReplaceStr
.getLength();
1302 if( lStartPos
<= nExpStrLen
)
1304 sal_Int32 nPos
= lStartPos
- 1;
1305 sal_Int32 nCounts
= 0;
1306 while( lCount
== -1 || lCount
> nCounts
)
1308 OUString
aSrcStr( aExpStr
);
1311 aSrcStr
= aSrcStr
.toAsciiUpperCase();
1312 aFindStr
= aFindStr
.toAsciiUpperCase();
1314 nPos
= aSrcStr
.indexOf( aFindStr
, nPos
);
1317 aExpStr
= aExpStr
.replaceAt( nPos
, nFindStrLen
, aReplaceStr
);
1318 nPos
= nPos
+ nReplaceStrLen
;
1327 rPar
.Get(0)->PutString( aExpStr
.copy( lStartPos
- 1 ) );
1331 void SbRtl_Right(StarBASIC
*, SbxArray
& rPar
, bool)
1333 if ( rPar
.Count() < 3 )
1335 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1339 const OUString
& rStr
= rPar
.Get(1)->GetOUString();
1340 int nResultLen
= rPar
.Get(2)->GetLong();
1341 if( nResultLen
< 0 )
1344 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1346 int nStrLen
= rStr
.getLength();
1347 if ( nResultLen
> nStrLen
)
1349 nResultLen
= nStrLen
;
1351 OUString aResultStr
= rStr
.copy( nStrLen
- nResultLen
);
1352 rPar
.Get(0)->PutString( aResultStr
);
1356 void SbRtl_RTL(StarBASIC
* pBasic
, SbxArray
& rPar
, bool)
1358 rPar
.Get( 0 )->PutObject( pBasic
->getRTL().get() );
1361 void SbRtl_RTrim(StarBASIC
*, SbxArray
& rPar
, bool)
1363 if ( rPar
.Count() < 2 )
1365 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1369 OUString
aStr(comphelper::string::stripEnd(rPar
.Get(1)->GetOUString(), ' '));
1370 rPar
.Get(0)->PutString(aStr
);
1374 void SbRtl_Sgn(StarBASIC
*, SbxArray
& rPar
, bool)
1376 if ( rPar
.Count() < 2 )
1378 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1382 double aDouble
= rPar
.Get(1)->GetDouble();
1383 sal_Int16 nResult
= 0;
1388 else if ( aDouble
< 0 )
1392 rPar
.Get(0)->PutInteger( nResult
);
1396 void SbRtl_Space(StarBASIC
*, SbxArray
& rPar
, bool)
1398 if ( rPar
.Count() < 2 )
1400 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1404 OUStringBuffer aBuf
;
1405 string::padToLength(aBuf
, rPar
.Get(1)->GetLong(), ' ');
1406 rPar
.Get(0)->PutString(aBuf
.makeStringAndClear());
1410 void SbRtl_Spc(StarBASIC
*, SbxArray
& rPar
, bool)
1412 if ( rPar
.Count() < 2 )
1414 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1418 OUStringBuffer aBuf
;
1419 string::padToLength(aBuf
, rPar
.Get(1)->GetLong(), ' ');
1420 rPar
.Get(0)->PutString(aBuf
.makeStringAndClear());
1424 void SbRtl_Sqr(StarBASIC
*, SbxArray
& rPar
, bool)
1426 if ( rPar
.Count() < 2 )
1428 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1432 double aDouble
= rPar
.Get(1)->GetDouble();
1435 rPar
.Get(0)->PutDouble( sqrt( aDouble
));
1439 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1444 void SbRtl_Str(StarBASIC
*, SbxArray
& rPar
, bool)
1446 if ( rPar
.Count() < 2 )
1448 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1453 OUString
aStrNew("");
1454 SbxVariableRef pArg
= rPar
.Get( 1 );
1455 pArg
->Format( aStr
);
1457 // Numbers start with a space
1458 if( pArg
->IsNumericRTL() )
1460 // replace commas by points so that it's symmetric to Val!
1461 aStr
= aStr
.replaceFirst( ",", "." );
1463 SbiInstance
* pInst
= GetSbData()->pInst
;
1464 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
1465 if( bCompatibility
)
1467 sal_Int32 nLen
= aStr
.getLength();
1469 const sal_Unicode
* pBuf
= aStr
.getStr();
1471 bool bNeg
= ( pBuf
[0] == '-' );
1472 sal_Int32 iZeroSearch
= 0;
1480 if( pBuf
[0] != ' ' )
1485 sal_Int32 iNext
= iZeroSearch
+ 1;
1486 if( pBuf
[iZeroSearch
] == '0' && nLen
> iNext
&& pBuf
[iNext
] == '.' )
1490 aStrNew
+= aStr
.copy(iZeroSearch
);
1494 aStrNew
= " " + aStr
;
1501 rPar
.Get(0)->PutString( aStrNew
);
1505 void SbRtl_StrComp(StarBASIC
*, SbxArray
& rPar
, bool)
1507 if ( rPar
.Count() < 3 )
1509 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1510 rPar
.Get(0)->PutEmpty();
1513 const OUString
& rStr1
= rPar
.Get(1)->GetOUString();
1514 const OUString
& rStr2
= rPar
.Get(2)->GetOUString();
1516 SbiInstance
* pInst
= GetSbData()->pInst
;
1518 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
1519 if( bCompatibility
)
1521 SbiRuntime
* pRT
= pInst
->pRun
;
1522 bTextCompare
= pRT
&& pRT
->IsImageFlag( SbiImageFlags::COMPARETEXT
);
1526 bTextCompare
= true;
1528 if ( rPar
.Count() == 4 )
1529 bTextCompare
= rPar
.Get(3)->GetInteger();
1531 if( !bCompatibility
)
1533 bTextCompare
= !bTextCompare
;
1535 sal_Int32 nRetValue
= 0;
1538 ::utl::TransliterationWrapper
* pTransliterationWrapper
= GetSbData()->pTransliterationWrapper
.get();
1539 if( !pTransliterationWrapper
)
1541 uno::Reference
< uno::XComponentContext
> xContext
= getProcessComponentContext();
1542 GetSbData()->pTransliterationWrapper
.reset(
1543 new ::utl::TransliterationWrapper( xContext
,
1544 TransliterationFlags::IGNORE_CASE
|
1545 TransliterationFlags::IGNORE_KANA
|
1546 TransliterationFlags::IGNORE_WIDTH
) );
1547 pTransliterationWrapper
= GetSbData()->pTransliterationWrapper
.get();
1550 LanguageType eLangType
= Application::GetSettings().GetLanguageTag().getLanguageType();
1551 pTransliterationWrapper
->loadModuleIfNeeded( eLangType
);
1552 nRetValue
= pTransliterationWrapper
->compareString( rStr1
, rStr2
);
1557 aResult
= rStr1
.compareTo( rStr2
);
1562 else if ( aResult
> 0)
1567 rPar
.Get(0)->PutInteger( sal::static_int_cast
< sal_Int16
>( nRetValue
) );
1570 void SbRtl_String(StarBASIC
*, SbxArray
& rPar
, bool)
1572 if ( rPar
.Count() < 2 )
1574 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1578 sal_Unicode aFiller
;
1579 sal_Int32 lCount
= rPar
.Get(1)->GetLong();
1580 if( lCount
< 0 || lCount
> 0xffff )
1582 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1584 if( rPar
.Get(2)->GetType() == SbxINTEGER
)
1586 aFiller
= static_cast<sal_Unicode
>(rPar
.Get(2)->GetInteger());
1590 const OUString
& rStr
= rPar
.Get(2)->GetOUString();
1593 OUStringBuffer
aBuf(lCount
);
1594 string::padToLength(aBuf
, lCount
, aFiller
);
1595 rPar
.Get(0)->PutString(aBuf
.makeStringAndClear());
1599 void SbRtl_Tab(StarBASIC
*, SbxArray
& rPar
, bool)
1601 if ( rPar
.Count() < 2 )
1602 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1605 OUStringBuffer aStr
;
1606 comphelper::string::padToLength(aStr
, rPar
.Get(1)->GetLong(), '\t');
1607 rPar
.Get(0)->PutString(aStr
.makeStringAndClear());
1611 void SbRtl_Tan(StarBASIC
*, SbxArray
& rPar
, bool)
1613 if ( rPar
.Count() < 2 )
1615 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1619 SbxVariableRef pArg
= rPar
.Get( 1 );
1620 rPar
.Get( 0 )->PutDouble( tan( pArg
->GetDouble() ) );
1624 void SbRtl_UCase(StarBASIC
*, SbxArray
& rPar
, bool)
1626 if ( rPar
.Count() < 2 )
1628 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1632 const CharClass
& rCharClass
= GetCharClass();
1633 OUString
aStr( rPar
.Get(1)->GetOUString() );
1634 aStr
= rCharClass
.uppercase( aStr
);
1635 rPar
.Get(0)->PutString( aStr
);
1640 void SbRtl_Val(StarBASIC
* pBasic
, SbxArray
& rPar
, bool bWrite
)
1645 if ( rPar
.Count() < 2 )
1647 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1651 double nResult
= 0.0;
1654 OUString
aStr( rPar
.Get(1)->GetOUString() );
1656 FilterWhiteSpace( aStr
);
1657 if ( aStr
.getLength() > 1 && aStr
[0] == '&' )
1660 char aChar
= static_cast<char>(aStr
[1]);
1661 if ( aChar
== 'h' || aChar
== 'H' )
1665 else if ( aChar
== 'o' || aChar
== 'O' )
1671 OString
aByteStr(OUStringToOString(aStr
, osl_getThreadTextEncoding()));
1672 sal_Int16 nlResult
= static_cast<sal_Int16
>(strtol( aByteStr
.getStr()+2, &pEndPtr
, nRadix
));
1673 nResult
= static_cast<double>(nlResult
);
1678 rtl_math_ConversionStatus eStatus
= rtl_math_ConversionStatus_Ok
;
1679 sal_Int32 nParseEnd
= 0;
1680 nResult
= ::rtl::math::stringToDouble( aStr
, '.', ',', &eStatus
, &nParseEnd
);
1681 if ( eStatus
!= rtl_math_ConversionStatus_Ok
)
1682 StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW
);
1683 /* TODO: we should check whether all characters were parsed here,
1684 * but earlier code silently ignored trailing nonsense such as "1x"
1685 * resulting in 1 with the side effect that any alpha-only-string
1686 * like "x" resulted in 0. Not changing that now (2013-03-22) as
1687 * user macros may rely on it. */
1689 else if ( nParseEnd
!= aStr
.getLength() )
1690 StarBASIC::Error( ERRCODE_BASIC_CONVERSION
);
1694 rPar
.Get(0)->PutDouble( nResult
);
1699 // Helper functions for date conversion
1700 sal_Int16
implGetDateDay( double aDate
)
1702 aDate
-= 2.0; // standardize: 1.1.1900 => 0.0
1703 aDate
= floor( aDate
);
1704 Date
aRefDate( 1, 1, 1900 );
1705 aRefDate
.AddDays( aDate
);
1707 sal_Int16 nRet
= static_cast<sal_Int16
>( aRefDate
.GetDay() );
1711 sal_Int16
implGetDateMonth( double aDate
)
1713 Date
aRefDate( 1,1,1900 );
1714 sal_Int32 nDays
= static_cast<sal_Int32
>(aDate
);
1715 nDays
-= 2; // standardize: 1.1.1900 => 0.0
1716 aRefDate
.AddDays( nDays
);
1717 sal_Int16 nRet
= static_cast<sal_Int16
>( aRefDate
.GetMonth() );
1721 css::util::Date
SbxDateToUNODate( const SbxValue
* const pVal
)
1723 double aDate
= pVal
->GetDate();
1725 css::util::Date aUnoDate
;
1726 aUnoDate
.Day
= implGetDateDay ( aDate
);
1727 aUnoDate
.Month
= implGetDateMonth( aDate
);
1728 aUnoDate
.Year
= implGetDateYear ( aDate
);
1733 void SbxDateFromUNODate( SbxValue
*pVal
, const css::util::Date
& aUnoDate
)
1736 if( implDateSerial( aUnoDate
.Year
, aUnoDate
.Month
, aUnoDate
.Day
, false, SbDateCorrection::None
, dDate
) )
1738 pVal
->PutDate( dDate
);
1742 // Function to convert date to UNO date (com.sun.star.util.Date)
1743 void SbRtl_CDateToUnoDate(StarBASIC
*, SbxArray
& rPar
, bool)
1745 if ( rPar
.Count() != 2 )
1747 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1751 unoToSbxValue(rPar
.Get(0), Any(SbxDateToUNODate(rPar
.Get(1))));
1754 // Function to convert date from UNO date (com.sun.star.util.Date)
1755 void SbRtl_CDateFromUnoDate(StarBASIC
*, SbxArray
& rPar
, bool)
1757 if ( rPar
.Count() != 2 || rPar
.Get(1)->GetType() != SbxOBJECT
)
1759 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1763 Any
aAny (sbxToUnoValue(rPar
.Get(1), cppu::UnoType
<css::util::Date
>::get()));
1764 css::util::Date aUnoDate
;
1765 if(aAny
>>= aUnoDate
)
1766 SbxDateFromUNODate(rPar
.Get(0), aUnoDate
);
1768 SbxBase::SetError( ERRCODE_BASIC_CONVERSION
);
1771 css::util::Time
SbxDateToUNOTime( const SbxValue
* const pVal
)
1773 double aDate
= pVal
->GetDate();
1775 css::util::Time aUnoTime
;
1776 aUnoTime
.Hours
= implGetHour ( aDate
);
1777 aUnoTime
.Minutes
= implGetMinute ( aDate
);
1778 aUnoTime
.Seconds
= implGetSecond ( aDate
);
1779 aUnoTime
.NanoSeconds
= 0;
1784 void SbxDateFromUNOTime( SbxValue
*pVal
, const css::util::Time
& aUnoTime
)
1786 pVal
->PutDate( implTimeSerial(aUnoTime
.Hours
, aUnoTime
.Minutes
, aUnoTime
.Seconds
) );
1789 // Function to convert date to UNO time (com.sun.star.util.Time)
1790 void SbRtl_CDateToUnoTime(StarBASIC
*, SbxArray
& rPar
, bool)
1792 if ( rPar
.Count() != 2 )
1794 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1798 unoToSbxValue(rPar
.Get(0), Any(SbxDateToUNOTime(rPar
.Get(1))));
1801 // Function to convert date from UNO time (com.sun.star.util.Time)
1802 void SbRtl_CDateFromUnoTime(StarBASIC
*, SbxArray
& rPar
, bool)
1804 if ( rPar
.Count() != 2 || rPar
.Get(1)->GetType() != SbxOBJECT
)
1806 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1810 Any
aAny (sbxToUnoValue(rPar
.Get(1), cppu::UnoType
<css::util::Time
>::get()));
1811 css::util::Time aUnoTime
;
1812 if(aAny
>>= aUnoTime
)
1813 SbxDateFromUNOTime(rPar
.Get(0), aUnoTime
);
1815 SbxBase::SetError( ERRCODE_BASIC_CONVERSION
);
1818 css::util::DateTime
SbxDateToUNODateTime( const SbxValue
* const pVal
)
1820 double aDate
= pVal
->GetDate();
1822 css::util::DateTime aUnoDT
;
1823 aUnoDT
.Day
= implGetDateDay ( aDate
);
1824 aUnoDT
.Month
= implGetDateMonth( aDate
);
1825 aUnoDT
.Year
= implGetDateYear ( aDate
);
1826 aUnoDT
.Hours
= implGetHour ( aDate
);
1827 aUnoDT
.Minutes
= implGetMinute ( aDate
);
1828 aUnoDT
.Seconds
= implGetSecond ( aDate
);
1829 aUnoDT
.NanoSeconds
= 0;
1834 void SbxDateFromUNODateTime( SbxValue
*pVal
, const css::util::DateTime
& aUnoDT
)
1837 if( implDateTimeSerial( aUnoDT
.Year
, aUnoDT
.Month
, aUnoDT
.Day
,
1838 aUnoDT
.Hours
, aUnoDT
.Minutes
, aUnoDT
.Seconds
,
1841 pVal
->PutDate( dDate
);
1845 // Function to convert date to UNO date (com.sun.star.util.Date)
1846 void SbRtl_CDateToUnoDateTime(StarBASIC
*, SbxArray
& rPar
, bool)
1848 if ( rPar
.Count() != 2 )
1850 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1854 unoToSbxValue(rPar
.Get(0), Any(SbxDateToUNODateTime(rPar
.Get(1))));
1857 // Function to convert date from UNO date (com.sun.star.util.Date)
1858 void SbRtl_CDateFromUnoDateTime(StarBASIC
*, SbxArray
& rPar
, bool)
1860 if ( rPar
.Count() != 2 || rPar
.Get(1)->GetType() != SbxOBJECT
)
1862 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1866 Any
aAny (sbxToUnoValue(rPar
.Get(1), cppu::UnoType
<css::util::DateTime
>::get()));
1867 css::util::DateTime aUnoDT
;
1869 SbxDateFromUNODateTime(rPar
.Get(0), aUnoDT
);
1871 SbxBase::SetError( ERRCODE_BASIC_CONVERSION
);
1874 // Function to convert date to ISO 8601 date format YYYYMMDD
1875 void SbRtl_CDateToIso(StarBASIC
*, SbxArray
& rPar
, bool)
1877 if ( rPar
.Count() == 2 )
1879 double aDate
= rPar
.Get(1)->GetDate();
1881 // Date may actually even be -YYYYYMMDD
1883 sal_Int16 nYear
= implGetDateYear( aDate
);
1884 snprintf( Buffer
, sizeof( Buffer
), (nYear
< 0 ? "%05d%02d%02d" : "%04d%02d%02d"),
1885 static_cast<int>(nYear
),
1886 static_cast<int>(implGetDateMonth( aDate
)),
1887 static_cast<int>(implGetDateDay( aDate
)) );
1888 OUString aRetStr
= OUString::createFromAscii( Buffer
);
1889 rPar
.Get(0)->PutString( aRetStr
);
1893 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1897 // Function to convert date from ISO 8601 date format YYYYMMDD or YYYY-MM-DD
1898 // And even YYMMDD for compatibility, sigh...
1899 void SbRtl_CDateFromIso(StarBASIC
*, SbxArray
& rPar
, bool)
1901 if ( rPar
.Count() == 2 )
1905 OUString aStr
= rPar
.Get(1)->GetOUString();
1909 // Valid formats are
1910 // YYYYMMDD -YYYMMDD YYYYYMMDD -YYYYYMMDD YYMMDD
1911 // YYYY-MM-DD -YYYY-MM-DD YYYYY-MM-DD -YYYYY-MM-DD
1913 sal_Int32 nSign
= 1;
1917 aStr
= aStr
.copy(1);
1919 const sal_Int32 nLen
= aStr
.getLength();
1921 // Signed YYMMDD two digit year is invalid.
1922 if (nLen
== 6 && nSign
== -1)
1926 // YYYYMMDD YYYYYMMDD YYMMDD
1927 // YYYY-MM-DD YYYYY-MM-DD
1928 if (nLen
!= 6 && (nLen
< 8 || 11 < nLen
))
1931 bool bUseTwoDigitYear
= false;
1932 OUString aYearStr
, aMonthStr
, aDayStr
;
1933 if (nLen
== 6 || nLen
== 8 || nLen
== 9)
1936 if (!comphelper::string::isdigitAsciiString(aStr
))
1939 const sal_Int32 nMonthPos
= (nLen
== 8 ? 4 : (nLen
== 6 ? 2 : 5));
1941 bUseTwoDigitYear
= true;
1942 aYearStr
= aStr
.copy( 0, nMonthPos
);
1943 aMonthStr
= aStr
.copy( nMonthPos
, 2 );
1944 aDayStr
= aStr
.copy( nMonthPos
+ 2, 2 );
1949 const sal_Int32 nMonthSep
= (nLen
== 11 ? 5 : 4);
1950 if (aStr
.indexOf('-') != nMonthSep
)
1952 if (aStr
.indexOf('-', nMonthSep
+ 1) != nMonthSep
+ 3)
1955 aYearStr
= aStr
.copy( 0, nMonthSep
);
1956 aMonthStr
= aStr
.copy( nMonthSep
+ 1, 2 );
1957 aDayStr
= aStr
.copy( nMonthSep
+ 4, 2 );
1958 if ( !comphelper::string::isdigitAsciiString(aYearStr
) ||
1959 !comphelper::string::isdigitAsciiString(aMonthStr
) ||
1960 !comphelper::string::isdigitAsciiString(aDayStr
))
1965 if (!implDateSerial( static_cast<sal_Int16
>(nSign
* aYearStr
.toInt32()),
1966 static_cast<sal_Int16
>(aMonthStr
.toInt32()), static_cast<sal_Int16
>(aDayStr
.toInt32()),
1967 bUseTwoDigitYear
, SbDateCorrection::None
, dDate
))
1970 rPar
.Get(0)->PutDate( dDate
);
1976 SbxBase::SetError( ERRCODE_BASIC_BAD_PARAMETER
);
1980 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1984 void SbRtl_DateSerial(StarBASIC
*, SbxArray
& rPar
, bool)
1986 if ( rPar
.Count() < 4 )
1988 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
1991 sal_Int16 nYear
= rPar
.Get(1)->GetInteger();
1992 sal_Int16 nMonth
= rPar
.Get(2)->GetInteger();
1993 sal_Int16 nDay
= rPar
.Get(3)->GetInteger();
1996 if( implDateSerial( nYear
, nMonth
, nDay
, true, SbDateCorrection::RollOver
, dDate
) )
1998 rPar
.Get(0)->PutDate( dDate
);
2002 void SbRtl_TimeSerial(StarBASIC
*, SbxArray
& rPar
, bool)
2004 if ( rPar
.Count() < 4 )
2006 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2009 sal_Int16 nHour
= rPar
.Get(1)->GetInteger();
2012 nHour
= 0; // because of UNO DateTimes, which go till 24 o'clock
2014 sal_Int16 nMinute
= rPar
.Get(2)->GetInteger();
2015 sal_Int16 nSecond
= rPar
.Get(3)->GetInteger();
2016 if ((nHour
< 0 || nHour
> 23) ||
2017 (nMinute
< 0 || nMinute
> 59 ) ||
2018 (nSecond
< 0 || nSecond
> 59 ))
2020 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2024 rPar
.Get(0)->PutDate( implTimeSerial(nHour
, nMinute
, nSecond
) ); // JSM
2027 void SbRtl_DateValue(StarBASIC
*, SbxArray
& rPar
, bool)
2029 if ( rPar
.Count() < 2 )
2031 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2035 // #39629 check GetSbData()->pInst, can be called from the URL line
2036 std::shared_ptr
<SvNumberFormatter
> pFormatter
;
2037 if( GetSbData()->pInst
)
2039 pFormatter
= GetSbData()->pInst
->GetNumberFormatter();
2043 sal_uInt32 n
; // Dummy
2044 pFormatter
= SbiInstance::PrepareNumberFormatter( n
, n
, n
);
2047 LanguageType eLangType
= Application::GetSettings().GetLanguageTag().getLanguageType();
2048 sal_uInt32 nIndex
= pFormatter
->GetStandardIndex( eLangType
);
2050 OUString
aStr( rPar
.Get(1)->GetOUString() );
2051 bool bSuccess
= pFormatter
->IsNumberFormat( aStr
, nIndex
, fResult
);
2052 SvNumFormatType nType
= pFormatter
->GetType( nIndex
);
2054 // DateValue("February 12, 1969") raises error if the system locale is not en_US
2055 // It seems that both locale number formatter and English number
2056 // formatter are supported in Visual Basic.
2057 if( !bSuccess
&& ( eLangType
!= LANGUAGE_ENGLISH_US
) )
2059 // Try using LANGUAGE_ENGLISH_US to get the date value.
2060 nIndex
= pFormatter
->GetStandardIndex( LANGUAGE_ENGLISH_US
);
2061 bSuccess
= pFormatter
->IsNumberFormat( aStr
, nIndex
, fResult
);
2062 nType
= pFormatter
->GetType( nIndex
);
2065 if(bSuccess
&& (nType
==SvNumFormatType::DATE
|| nType
==SvNumFormatType::DATETIME
))
2067 if ( nType
== SvNumFormatType::DATETIME
)
2070 if ( fResult
> 0.0 )
2072 fResult
= floor( fResult
);
2076 fResult
= ceil( fResult
);
2079 rPar
.Get(0)->PutDate( fResult
);
2083 StarBASIC::Error( ERRCODE_BASIC_CONVERSION
);
2088 void SbRtl_TimeValue(StarBASIC
*, SbxArray
& rPar
, bool)
2090 if ( rPar
.Count() < 2 )
2092 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2096 std::shared_ptr
<SvNumberFormatter
> pFormatter
;
2097 if( GetSbData()->pInst
)
2098 pFormatter
= GetSbData()->pInst
->GetNumberFormatter();
2102 pFormatter
= SbiInstance::PrepareNumberFormatter( n
, n
, n
);
2105 sal_uInt32 nIndex
= 0;
2107 bool bSuccess
= pFormatter
->IsNumberFormat( rPar
.Get(1)->GetOUString(),
2109 SvNumFormatType nType
= pFormatter
->GetType(nIndex
);
2110 if(bSuccess
&& (nType
==SvNumFormatType::TIME
||nType
==SvNumFormatType::DATETIME
))
2112 if ( nType
== SvNumFormatType::DATETIME
)
2115 fResult
= fmod( fResult
, 1 );
2117 rPar
.Get(0)->PutDate( fResult
);
2121 StarBASIC::Error( ERRCODE_BASIC_CONVERSION
);
2126 void SbRtl_Day(StarBASIC
*, SbxArray
& rPar
, bool)
2128 if ( rPar
.Count() < 2 )
2130 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2134 SbxVariableRef pArg
= rPar
.Get( 1 );
2135 double aDate
= pArg
->GetDate();
2137 sal_Int16 nDay
= implGetDateDay( aDate
);
2138 rPar
.Get(0)->PutInteger( nDay
);
2142 void SbRtl_Year(StarBASIC
*, SbxArray
& rPar
, bool)
2144 if ( rPar
.Count() < 2 )
2146 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2150 sal_Int16 nYear
= implGetDateYear( rPar
.Get(1)->GetDate() );
2151 rPar
.Get(0)->PutInteger( nYear
);
2155 sal_Int16
implGetHour( double dDate
)
2157 double nFrac
= dDate
- floor( dDate
);
2159 sal_Int32 nSeconds
= static_cast<sal_Int32
>(nFrac
+ 0.5);
2160 sal_Int16 nHour
= static_cast<sal_Int16
>(nSeconds
/ 3600);
2164 void SbRtl_Hour(StarBASIC
*, SbxArray
& rPar
, bool)
2166 if ( rPar
.Count() < 2 )
2168 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2172 double nArg
= rPar
.Get(1)->GetDate();
2173 sal_Int16 nHour
= implGetHour( nArg
);
2174 rPar
.Get(0)->PutInteger( nHour
);
2178 void SbRtl_Minute(StarBASIC
*, SbxArray
& rPar
, bool)
2180 if ( rPar
.Count() < 2 )
2182 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2186 double nArg
= rPar
.Get(1)->GetDate();
2187 sal_Int16 nMin
= implGetMinute( nArg
);
2188 rPar
.Get(0)->PutInteger( nMin
);
2192 void SbRtl_Month(StarBASIC
*, SbxArray
& rPar
, bool)
2194 if ( rPar
.Count() < 2 )
2196 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2200 sal_Int16 nMonth
= implGetDateMonth( rPar
.Get(1)->GetDate() );
2201 rPar
.Get(0)->PutInteger( nMonth
);
2205 sal_Int16
implGetSecond( double dDate
)
2207 double nFrac
= dDate
- floor( dDate
);
2209 sal_Int32 nSeconds
= static_cast<sal_Int32
>(nFrac
+ 0.5);
2210 sal_Int16 nTemp
= static_cast<sal_Int16
>(nSeconds
/ 3600);
2211 nSeconds
-= nTemp
* 3600;
2212 nTemp
= static_cast<sal_Int16
>(nSeconds
/ 60);
2213 nSeconds
-= nTemp
* 60;
2215 sal_Int16 nRet
= static_cast<sal_Int16
>(nSeconds
);
2219 void SbRtl_Second(StarBASIC
*, SbxArray
& rPar
, bool)
2221 if ( rPar
.Count() < 2 )
2223 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2227 double nArg
= rPar
.Get(1)->GetDate();
2228 sal_Int16 nSecond
= implGetSecond( nArg
);
2229 rPar
.Get(0)->PutInteger( nSecond
);
2235 DateTime
aDateTime( DateTime::SYSTEM
);
2236 double aSerial
= static_cast<double>(GetDayDiff( aDateTime
));
2237 long nSeconds
= aDateTime
.GetHour();
2239 nSeconds
+= aDateTime
.GetMin() * 60;
2240 nSeconds
+= aDateTime
.GetSec();
2241 double nDays
= static_cast<double>(nSeconds
) / (24.0*3600.0);
2248 void SbRtl_Now(StarBASIC
*, SbxArray
& rPar
, bool)
2250 rPar
.Get(0)->PutDate( Now_Impl() );
2255 void SbRtl_Time(StarBASIC
*, SbxArray
& rPar
, bool bWrite
)
2259 tools::Time
aTime( tools::Time::SYSTEM
);
2260 SbxVariable
* pMeth
= rPar
.Get( 0 );
2262 if( pMeth
->IsFixed() )
2266 snprintf( buf
, sizeof(buf
), "%02d:%02d:%02d",
2267 aTime
.GetHour(), aTime
.GetMin(), aTime
.GetSec() );
2268 aRes
= OUString::createFromAscii( buf
);
2272 // Time: system dependent
2273 long nSeconds
=aTime
.GetHour();
2275 nSeconds
+= aTime
.GetMin() * 60;
2276 nSeconds
+= aTime
.GetSec();
2277 double nDays
= static_cast<double>(nSeconds
) * ( 1.0 / (24.0*3600.0) );
2280 std::shared_ptr
<SvNumberFormatter
> pFormatter
;
2282 if( GetSbData()->pInst
)
2284 pFormatter
= GetSbData()->pInst
->GetNumberFormatter();
2285 nIndex
= GetSbData()->pInst
->GetStdTimeIdx();
2289 sal_uInt32 n
; // Dummy
2290 pFormatter
= SbiInstance::PrepareNumberFormatter( n
, nIndex
, n
);
2293 pFormatter
->GetOutputString( nDays
, nIndex
, aRes
, &pCol
);
2295 pMeth
->PutString( aRes
);
2299 StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED
);
2303 void SbRtl_Timer(StarBASIC
*, SbxArray
& rPar
, bool)
2305 tools::Time
aTime( tools::Time::SYSTEM
);
2306 long nSeconds
= aTime
.GetHour();
2308 nSeconds
+= aTime
.GetMin() * 60;
2309 nSeconds
+= aTime
.GetSec();
2310 rPar
.Get(0)->PutDate( static_cast<double>(nSeconds
) );
2314 void SbRtl_Date(StarBASIC
*, SbxArray
& rPar
, bool bWrite
)
2318 Date
aToday( Date::SYSTEM
);
2319 double nDays
= static_cast<double>(GetDayDiff( aToday
));
2320 SbxVariable
* pMeth
= rPar
.Get( 0 );
2321 if( pMeth
->IsString() )
2326 std::shared_ptr
<SvNumberFormatter
> pFormatter
;
2328 if( GetSbData()->pInst
)
2330 pFormatter
= GetSbData()->pInst
->GetNumberFormatter();
2331 nIndex
= GetSbData()->pInst
->GetStdDateIdx();
2336 pFormatter
= SbiInstance::PrepareNumberFormatter( nIndex
, n
, n
);
2339 pFormatter
->GetOutputString( nDays
, nIndex
, aRes
, &pCol
);
2340 pMeth
->PutString( aRes
);
2344 pMeth
->PutDate( nDays
);
2349 StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED
);
2353 void SbRtl_IsArray(StarBASIC
*, SbxArray
& rPar
, bool)
2355 if ( rPar
.Count() < 2 )
2357 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2361 rPar
.Get(0)->PutBool((rPar
.Get(1)->GetType() & SbxARRAY
) != 0);
2365 void SbRtl_IsObject(StarBASIC
*, SbxArray
& rPar
, bool)
2367 if ( rPar
.Count() < 2 )
2369 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2373 SbxVariable
* pVar
= rPar
.Get(1);
2374 bool bObject
= pVar
->IsObject();
2375 SbxBase
* pObj
= (bObject
? pVar
->GetObject() : nullptr);
2377 if( auto pUnoClass
= dynamic_cast<SbUnoClass
*>( pObj
) )
2379 bObject
= pUnoClass
->getUnoClass().is();
2381 rPar
.Get( 0 )->PutBool( bObject
);
2385 void SbRtl_IsDate(StarBASIC
*, SbxArray
& rPar
, bool)
2387 if ( rPar
.Count() < 2 )
2389 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2393 // #46134 only string is converted, all other types result in sal_False
2394 SbxVariableRef xArg
= rPar
.Get( 1 );
2395 SbxDataType eType
= xArg
->GetType();
2398 if( eType
== SbxDATE
)
2402 else if( eType
== SbxSTRING
)
2404 ErrCode nPrevError
= SbxBase::GetError();
2405 SbxBase::ResetError();
2407 // force conversion of the parameter to SbxDATE
2408 xArg
->SbxValue::GetDate();
2410 bDate
= !SbxBase::IsError();
2412 SbxBase::ResetError();
2413 SbxBase::SetError( nPrevError
);
2415 rPar
.Get( 0 )->PutBool( bDate
);
2419 void SbRtl_IsEmpty(StarBASIC
*, SbxArray
& rPar
, bool)
2421 if ( rPar
.Count() < 2 )
2423 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2427 SbxVariable
* pVar
= nullptr;
2428 if( SbiRuntime::isVBAEnabled() )
2430 pVar
= getDefaultProp( rPar
.Get(1) );
2434 pVar
->Broadcast( SfxHintId::BasicDataWanted
);
2435 rPar
.Get( 0 )->PutBool( pVar
->IsEmpty() );
2439 rPar
.Get( 0 )->PutBool( rPar
.Get(1)->IsEmpty() );
2444 void SbRtl_IsError(StarBASIC
*, SbxArray
& rPar
, bool)
2446 if ( rPar
.Count() < 2 )
2448 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2452 SbxVariable
* pVar
=rPar
.Get( 1 );
2453 SbUnoObject
* pObj
= dynamic_cast<SbUnoObject
*>( pVar
);
2456 if ( SbxBase
* pBaseObj
= (pVar
->IsObject() ? pVar
->GetObject() : nullptr) )
2458 pObj
= dynamic_cast<SbUnoObject
*>( pBaseObj
);
2461 uno::Reference
< script::XErrorQuery
> xError
;
2464 xError
.set( pObj
->getUnoAny(), uno::UNO_QUERY
);
2468 rPar
.Get( 0 )->PutBool( xError
->hasError() );
2472 rPar
.Get( 0 )->PutBool( rPar
.Get(1)->IsErr() );
2477 void SbRtl_IsNull(StarBASIC
*, SbxArray
& rPar
, bool)
2479 if ( rPar
.Count() < 2 )
2481 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2485 // #51475 because of Uno-objects return true
2486 // even if the pObj value is NULL
2487 SbxVariableRef pArg
= rPar
.Get( 1 );
2488 bool bNull
= rPar
.Get(1)->IsNull();
2489 if( !bNull
&& pArg
->GetType() == SbxOBJECT
)
2491 SbxBase
* pObj
= pArg
->GetObject();
2497 rPar
.Get( 0 )->PutBool( bNull
);
2501 void SbRtl_IsNumeric(StarBASIC
*, SbxArray
& rPar
, bool)
2503 if ( rPar
.Count() < 2 )
2505 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2509 rPar
.Get( 0 )->PutBool( rPar
.Get( 1 )->IsNumericRTL() );
2514 void SbRtl_IsMissing(StarBASIC
*, SbxArray
& rPar
, bool)
2516 if ( rPar
.Count() < 2 )
2518 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2522 // #57915 Missing is reported by an error
2523 rPar
.Get( 0 )->PutBool( rPar
.Get(1)->IsErr() );
2527 // Function looks for wildcards, removes them and always returns the pure path
2528 static OUString
implSetupWildcard(const OUString
& rFileParam
, SbiRTLData
& rRTLData
)
2530 static const sal_Char cDelim1
= '/';
2531 static const sal_Char cDelim2
= '\\';
2532 static const sal_Char cWild1
= '*';
2533 static const sal_Char cWild2
= '?';
2535 rRTLData
.pWildCard
.reset();
2536 rRTLData
.sFullNameToBeChecked
.clear();
2538 OUString aFileParam
= rFileParam
;
2539 sal_Int32 nLastWild
= aFileParam
.lastIndexOf( cWild1
);
2542 nLastWild
= aFileParam
.lastIndexOf( cWild2
);
2544 bool bHasWildcards
= ( nLastWild
>= 0 );
2547 sal_Int32 nLastDelim
= aFileParam
.lastIndexOf( cDelim1
);
2548 if( nLastDelim
< 0 )
2550 nLastDelim
= aFileParam
.lastIndexOf( cDelim2
);
2554 // Wildcards in path?
2555 if( nLastDelim
>= 0 && nLastDelim
> nLastWild
)
2562 OUString aPathStr
= getFullPath( aFileParam
);
2563 if( nLastDelim
!= aFileParam
.getLength() - 1 )
2565 rRTLData
.sFullNameToBeChecked
= aPathStr
;
2570 OUString aPureFileName
;
2571 if( nLastDelim
< 0 )
2573 aPureFileName
= aFileParam
;
2578 aPureFileName
= aFileParam
.copy( nLastDelim
+ 1 );
2579 aFileParam
= aFileParam
.copy( 0, nLastDelim
);
2582 // Try again to get a valid URL/UNC-path with only the path
2583 OUString aPathStr
= getFullPath( aFileParam
);
2585 // Is there a pure file name left? Otherwise the path is
2586 // invalid anyway because it was not accepted by OSL before
2587 if (aPureFileName
!= "*")
2589 rRTLData
.pWildCard
= std::make_unique
<WildCard
>(aPureFileName
);
2594 static bool implCheckWildcard(const OUString
& rName
, SbiRTLData
const& rRTLData
)
2598 if (rRTLData
.pWildCard
)
2600 bMatch
= rRTLData
.pWildCard
->Matches(rName
);
2606 static bool isRootDir( const OUString
& aDirURLStr
)
2608 INetURLObject
aDirURLObj( aDirURLStr
);
2611 // Check if it's a root directory
2612 sal_Int32 nCount
= aDirURLObj
.getSegmentCount();
2614 // No segment means Unix root directory "file:///"
2619 // Exactly one segment needs further checking, because it
2620 // can be Unix "file:///foo/" -> no root
2621 // or Windows "file:///c:/" -> root
2622 else if( nCount
== 1 )
2624 OUString aSeg1
= aDirURLObj
.getName( 0, true,
2625 INetURLObject::DecodeMechanism::WithCharset
);
2626 if( aSeg1
[1] == ':' )
2631 // More than one segments can never be root
2632 // so bRoot remains false
2637 void SbRtl_Dir(StarBASIC
*, SbxArray
& rPar
, bool)
2641 sal_uInt16 nParCount
= rPar
.Count();
2644 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
2648 SbiRTLData
& rRTLData
= GetSbData()->pInst
->GetRTLData();
2652 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
2655 if ( nParCount
>= 2 )
2657 OUString aFileParam
= rPar
.Get(1)->GetOUString();
2659 OUString aFileURLStr
= implSetupWildcard(aFileParam
, rRTLData
);
2660 if (!rRTLData
.sFullNameToBeChecked
.isEmpty())
2662 bool bExists
= false;
2663 try { bExists
= xSFI
->exists( aFileURLStr
); }
2664 catch(const Exception
& ) {}
2666 OUString aNameOnlyStr
;
2669 INetURLObject
aFileURL( aFileURLStr
);
2670 aNameOnlyStr
= aFileURL
.getName( INetURLObject::LAST_SEGMENT
,
2671 true, INetURLObject::DecodeMechanism::WithCharset
);
2673 rPar
.Get(0)->PutString( aNameOnlyStr
);
2679 OUString aDirURLStr
;
2680 bool bFolder
= xSFI
->isFolder( aFileURLStr
);
2684 aDirURLStr
= aFileURLStr
;
2688 rPar
.Get(0)->PutString( "" );
2691 SbAttributes nFlags
= SbAttributes::NONE
;
2692 if ( nParCount
> 2 )
2694 rRTLData
.nDirFlags
= nFlags
2695 = static_cast<SbAttributes
>(rPar
.Get(2)->GetInteger());
2699 rRTLData
.nDirFlags
= SbAttributes::NONE
;
2702 bool bIncludeFolders
= bool(nFlags
& SbAttributes::DIRECTORY
);
2703 rRTLData
.aDirSeq
= xSFI
->getFolderContents(aDirURLStr
, bIncludeFolders
);
2704 rRTLData
.nCurDirPos
= 0;
2706 // #78651 Add "." and ".." directories for VB compatibility
2707 if( bIncludeFolders
)
2709 bool bRoot
= isRootDir( aDirURLStr
);
2711 // If it's no root directory we flag the need for
2712 // the "." and ".." directories by the value -2
2713 // for the actual position. Later for -2 will be
2714 // returned "." and for -1 ".."
2717 rRTLData
.nCurDirPos
= -2;
2721 catch(const Exception
& )
2727 if (rRTLData
.aDirSeq
.hasElements())
2729 bool bFolderFlag
= bool(rRTLData
.nDirFlags
& SbAttributes::DIRECTORY
);
2731 SbiInstance
* pInst
= GetSbData()->pInst
;
2732 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
2735 if (rRTLData
.nCurDirPos
< 0)
2737 if (rRTLData
.nCurDirPos
== -2)
2741 else if (rRTLData
.nCurDirPos
== -1)
2745 rRTLData
.nCurDirPos
++;
2747 else if (rRTLData
.nCurDirPos
>= rRTLData
.aDirSeq
.getLength())
2749 rRTLData
.aDirSeq
.realloc(0);
2756 = rRTLData
.aDirSeq
.getConstArray()[rRTLData
.nCurDirPos
++];
2758 if( bCompatibility
)
2762 bool bFolder
= xSFI
->isFolder( aFile
);
2774 bool bFolder
= xSFI
->isFolder( aFile
);
2782 INetURLObject
aURL( aFile
);
2783 aPath
= aURL
.getName( INetURLObject::LAST_SEGMENT
, true,
2784 INetURLObject::DecodeMechanism::WithCharset
);
2787 bool bMatch
= implCheckWildcard(aPath
, rRTLData
);
2795 rPar
.Get(0)->PutString( aPath
);
2801 if ( nParCount
>= 2 )
2803 OUString aFileParam
= rPar
.Get(1)->GetOUString();
2805 OUString aDirURL
= implSetupWildcard(aFileParam
, rRTLData
);
2807 SbAttributes nFlags
= SbAttributes::NONE
;
2808 if ( nParCount
> 2 )
2810 rRTLData
.nDirFlags
= nFlags
2811 = static_cast<SbAttributes
>(rPar
.Get(2)->GetInteger());
2815 rRTLData
.nDirFlags
= SbAttributes::NONE
;
2819 bool bIncludeFolders
= bool(nFlags
& SbAttributes::DIRECTORY
);
2820 rRTLData
.pDir
= std::make_unique
<Directory
>(aDirURL
);
2821 FileBase::RC nRet
= rRTLData
.pDir
->open();
2822 if( nRet
!= FileBase::E_None
)
2824 rRTLData
.pDir
.reset();
2825 rPar
.Get(0)->PutString( OUString() );
2829 // #86950 Add "." and ".." directories for VB compatibility
2830 rRTLData
.nCurDirPos
= 0;
2831 if( bIncludeFolders
)
2833 bool bRoot
= isRootDir( aDirURL
);
2835 // If it's no root directory we flag the need for
2836 // the "." and ".." directories by the value -2
2837 // for the actual position. Later for -2 will be
2838 // returned "." and for -1 ".."
2841 rRTLData
.nCurDirPos
= -2;
2849 bool bFolderFlag
= bool(rRTLData
.nDirFlags
& SbAttributes::DIRECTORY
);
2852 if (rRTLData
.nCurDirPos
< 0)
2854 if (rRTLData
.nCurDirPos
== -2)
2858 else if (rRTLData
.nCurDirPos
== -1)
2862 rRTLData
.nCurDirPos
++;
2866 DirectoryItem aItem
;
2867 FileBase::RC nRet
= rRTLData
.pDir
->getNextItem(aItem
);
2868 if( nRet
!= FileBase::E_None
)
2870 rRTLData
.pDir
.reset();
2876 FileStatus
aFileStatus( osl_FileStatus_Mask_Type
| osl_FileStatus_Mask_FileName
);
2877 nRet
= aItem
.getFileStatus( aFileStatus
);
2878 if( nRet
!= FileBase::E_None
)
2880 SAL_WARN("basic", "getFileStatus failed");
2884 // Only directories?
2887 FileStatus::Type aType
= aFileStatus
.getFileType();
2888 bool bFolder
= isFolder( aType
);
2895 aPath
= aFileStatus
.getFileName();
2898 bool bMatch
= implCheckWildcard(aPath
, rRTLData
);
2906 rPar
.Get(0)->PutString( aPath
);
2912 void SbRtl_GetAttr(StarBASIC
* pBasic
, SbxArray
& rPar
, bool bWrite
)
2917 if ( rPar
.Count() == 2 )
2919 sal_Int16 nFlags
= 0;
2921 // In Windows, we want to use Windows API to get the file attributes
2922 // for VBA interoperability.
2924 if( SbiRuntime::isVBAEnabled() )
2926 OUString aPathURL
= getFullPath( rPar
.Get(1)->GetOUString() );
2928 FileBase::getSystemPathFromFileURL( aPathURL
, aPath
);
2929 DWORD nRealFlags
= GetFileAttributesW (o3tl::toW(aPath
.getStr()));
2930 if (nRealFlags
!= 0xffffffff)
2932 if (nRealFlags
== FILE_ATTRIBUTE_NORMAL
)
2936 nFlags
= static_cast<sal_Int16
>(nRealFlags
);
2940 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND
);
2942 rPar
.Get(0)->PutInteger( nFlags
);
2950 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
2955 OUString aPath
= getFullPath( rPar
.Get(1)->GetOUString() );
2956 bool bExists
= false;
2957 try { bExists
= xSFI
->exists( aPath
); }
2958 catch(const Exception
& ) {}
2961 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND
);
2965 bool bReadOnly
= xSFI
->isReadOnly( aPath
);
2966 bool bHidden
= xSFI
->isHidden( aPath
);
2967 bool bDirectory
= xSFI
->isFolder( aPath
);
2970 nFlags
|= sal_uInt16(SbAttributes::READONLY
);
2974 nFlags
|= sal_uInt16(SbAttributes::HIDDEN
);
2978 nFlags
|= sal_uInt16(SbAttributes::DIRECTORY
);
2981 catch(const Exception
& )
2983 StarBASIC::Error( ERRCODE_IO_GENERAL
);
2989 DirectoryItem aItem
;
2990 (void)DirectoryItem::get( getFullPath( rPar
.Get(1)->GetOUString() ), aItem
);
2991 FileStatus
aFileStatus( osl_FileStatus_Mask_Attributes
| osl_FileStatus_Mask_Type
);
2992 (void)aItem
.getFileStatus( aFileStatus
);
2993 sal_uInt64 nAttributes
= aFileStatus
.getAttributes();
2994 bool bReadOnly
= (nAttributes
& osl_File_Attribute_ReadOnly
) != 0;
2996 FileStatus::Type aType
= aFileStatus
.getFileType();
2997 bool bDirectory
= isFolder( aType
);
3000 nFlags
|= sal_uInt16(SbAttributes::READONLY
);
3004 nFlags
|= sal_uInt16(SbAttributes::DIRECTORY
);
3007 rPar
.Get(0)->PutInteger( nFlags
);
3011 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3016 void SbRtl_FileDateTime(StarBASIC
*, SbxArray
& rPar
, bool)
3018 if ( rPar
.Count() != 2 )
3020 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3024 OUString aPath
= rPar
.Get(1)->GetOUString();
3025 tools::Time
aTime( tools::Time::EMPTY
);
3026 Date
aDate( Date::EMPTY
);
3029 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
3034 util::DateTime aUnoDT
= xSFI
->getDateTimeModified( aPath
);
3035 aTime
= tools::Time( aUnoDT
);
3036 aDate
= Date( aUnoDT
);
3038 catch(const Exception
& )
3040 StarBASIC::Error( ERRCODE_IO_GENERAL
);
3046 bool bSuccess
= false;
3049 DirectoryItem aItem
;
3050 if (DirectoryItem::get( getFullPath( aPath
), aItem
) != FileBase::E_None
)
3053 FileStatus
aFileStatus( osl_FileStatus_Mask_ModifyTime
);
3054 if (aItem
.getFileStatus( aFileStatus
) != FileBase::E_None
)
3057 TimeValue aTimeVal
= aFileStatus
.getModifyTime();
3059 if (!osl_getDateTimeFromTimeValue( &aTimeVal
, &aDT
))
3060 // Strictly spoken this is not an i/o error but some other failure.
3063 aTime
= tools::Time( aDT
.Hours
, aDT
.Minutes
, aDT
.Seconds
, aDT
.NanoSeconds
);
3064 aDate
= Date( aDT
.Day
, aDT
.Month
, aDT
.Year
);
3070 StarBASIC::Error( ERRCODE_IO_GENERAL
);
3073 // An empty date shall not result in a formatted null-date (1899-12-30
3074 // or 1900-01-01) or even worse -0001-12-03 or some such due to how
3075 // GetDayDiff() treats things. There should be an error set in this
3076 // case anyway because of a missing file or other error above, but... so
3077 // do not even bother to use the number formatter.
3079 if (aDate
.IsEmpty())
3081 aRes
= "0000-00-00 00:00:00";
3085 double fSerial
= static_cast<double>(GetDayDiff( aDate
));
3086 long nSeconds
= aTime
.GetHour();
3088 nSeconds
+= aTime
.GetMin() * 60;
3089 nSeconds
+= aTime
.GetSec();
3090 double nDays
= static_cast<double>(nSeconds
) / (24.0*3600.0);
3095 std::shared_ptr
<SvNumberFormatter
> pFormatter
;
3097 if( GetSbData()->pInst
)
3099 pFormatter
= GetSbData()->pInst
->GetNumberFormatter();
3100 nIndex
= GetSbData()->pInst
->GetStdDateTimeIdx();
3105 pFormatter
= SbiInstance::PrepareNumberFormatter( n
, n
, nIndex
);
3108 pFormatter
->GetOutputString( fSerial
, nIndex
, aRes
, &pCol
);
3110 rPar
.Get(0)->PutString( aRes
);
3115 void SbRtl_EOF(StarBASIC
*, SbxArray
& rPar
, bool)
3117 // No changes for UCB
3118 if ( rPar
.Count() != 2 )
3120 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3124 sal_Int16 nChannel
= rPar
.Get(1)->GetInteger();
3125 SbiIoSystem
* pIO
= GetSbData()->pInst
->GetIoSystem();
3126 SbiStream
* pSbStrm
= pIO
->GetStream( nChannel
);
3129 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL
);
3133 SvStream
* pSvStrm
= pSbStrm
->GetStrm();
3134 if ( pSbStrm
->IsText() )
3137 (*pSvStrm
).ReadChar( cBla
); // can we read another character?
3138 beof
= pSvStrm
->eof();
3141 pSvStrm
->SeekRel( -1 );
3146 beof
= pSvStrm
->eof(); // for binary data!
3148 rPar
.Get(0)->PutBool( beof
);
3152 void SbRtl_FileAttr(StarBASIC
*, SbxArray
& rPar
, bool)
3154 // No changes for UCB
3155 // #57064 Although this function doesn't operate with DirEntry, it is
3156 // not touched by the adjustment to virtual URLs, as it only works on
3157 // already opened files and the name doesn't matter there.
3159 if ( rPar
.Count() != 3 )
3161 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3165 sal_Int16 nChannel
= rPar
.Get(1)->GetInteger();
3166 SbiIoSystem
* pIO
= GetSbData()->pInst
->GetIoSystem();
3167 SbiStream
* pSbStrm
= pIO
->GetStream( nChannel
);
3170 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL
);
3174 if ( rPar
.Get(2)->GetInteger() == 1 )
3176 nRet
= static_cast<sal_Int16
>(pSbStrm
->GetMode());
3180 nRet
= 0; // System file handle not supported
3182 rPar
.Get(0)->PutInteger( nRet
);
3185 void SbRtl_Loc(StarBASIC
*, SbxArray
& rPar
, bool)
3187 // No changes for UCB
3188 if ( rPar
.Count() != 2 )
3190 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3194 sal_Int16 nChannel
= rPar
.Get(1)->GetInteger();
3195 SbiIoSystem
* pIO
= GetSbData()->pInst
->GetIoSystem();
3196 SbiStream
* pSbStrm
= pIO
->GetStream( nChannel
);
3199 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL
);
3202 SvStream
* pSvStrm
= pSbStrm
->GetStrm();
3204 if( pSbStrm
->IsRandom())
3206 short nBlockLen
= pSbStrm
->GetBlockLen();
3207 nPos
= nBlockLen
? (pSvStrm
->Tell() / nBlockLen
) : 0;
3208 nPos
++; // block positions starting at 1
3210 else if ( pSbStrm
->IsText() )
3212 nPos
= pSbStrm
->GetLine();
3214 else if( pSbStrm
->IsBinary() )
3216 nPos
= pSvStrm
->Tell();
3218 else if ( pSbStrm
->IsSeq() )
3220 nPos
= ( pSvStrm
->Tell()+1 ) / 128;
3224 nPos
= pSvStrm
->Tell();
3226 rPar
.Get(0)->PutLong( static_cast<sal_Int32
>(nPos
) );
3230 void SbRtl_Lof(StarBASIC
*, SbxArray
& rPar
, bool)
3232 // No changes for UCB
3233 if ( rPar
.Count() != 2 )
3235 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3239 sal_Int16 nChannel
= rPar
.Get(1)->GetInteger();
3240 SbiIoSystem
* pIO
= GetSbData()->pInst
->GetIoSystem();
3241 SbiStream
* pSbStrm
= pIO
->GetStream( nChannel
);
3244 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL
);
3247 SvStream
* pSvStrm
= pSbStrm
->GetStrm();
3248 sal_uInt64
const nLen
= pSvStrm
->TellEnd();
3249 rPar
.Get(0)->PutLong( static_cast<sal_Int32
>(nLen
) );
3254 void SbRtl_Seek(StarBASIC
*, SbxArray
& rPar
, bool)
3256 // No changes for UCB
3257 int nArgs
= static_cast<int>(rPar
.Count());
3258 if ( nArgs
< 2 || nArgs
> 3 )
3260 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3263 sal_Int16 nChannel
= rPar
.Get(1)->GetInteger();
3264 SbiIoSystem
* pIO
= GetSbData()->pInst
->GetIoSystem();
3265 SbiStream
* pSbStrm
= pIO
->GetStream( nChannel
);
3268 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL
);
3271 SvStream
* pStrm
= pSbStrm
->GetStrm();
3273 if ( nArgs
== 2 ) // Seek-Function
3275 sal_uInt64 nPos
= pStrm
->Tell();
3276 if( pSbStrm
->IsRandom() )
3278 nPos
= nPos
/ pSbStrm
->GetBlockLen();
3280 nPos
++; // Basic counts from 1
3281 rPar
.Get(0)->PutLong( static_cast<sal_Int32
>(nPos
) );
3283 else // Seek-Statement
3285 sal_Int32 nPos
= rPar
.Get(2)->GetLong();
3288 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3291 nPos
--; // Basic counts from 1, SvStreams count from 0
3292 pSbStrm
->SetExpandOnWriteTo( 0 );
3293 if ( pSbStrm
->IsRandom() )
3295 nPos
*= pSbStrm
->GetBlockLen();
3297 pStrm
->Seek( static_cast<sal_uInt64
>(nPos
) );
3298 pSbStrm
->SetExpandOnWriteTo( nPos
);
3302 void SbRtl_Format(StarBASIC
*, SbxArray
& rPar
, bool)
3304 sal_uInt16 nArgCount
= rPar
.Count();
3305 if ( nArgCount
< 2 || nArgCount
> 3 )
3307 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3312 if( nArgCount
== 2 )
3314 rPar
.Get(1)->Format( aResult
);
3318 OUString
aFmt( rPar
.Get(2)->GetOUString() );
3319 rPar
.Get(1)->Format( aResult
, &aFmt
);
3321 rPar
.Get(0)->PutString( aResult
);
3325 // https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/formatnumber-function
3326 void SbRtl_FormatNumber(StarBASIC
*, SbxArray
& rPar
, bool)
3328 const sal_uInt16 nArgCount
= rPar
.Count();
3329 if (nArgCount
< 2 || nArgCount
> 6)
3331 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT
);
3335 // The UI locale never changes -> we can use static value here
3336 static const LocaleDataWrapper
localeData(Application::GetSettings().GetUILanguageTag());
3337 sal_Int16 nNumDigitsAfterDecimal
= -1;
3338 if (nArgCount
> 2 && !rPar
.Get(2)->IsEmpty())
3340 nNumDigitsAfterDecimal
= rPar
.Get(2)->GetInteger();
3341 if (nNumDigitsAfterDecimal
< -1)
3343 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT
);
3346 else if (nNumDigitsAfterDecimal
> 255)
3347 nNumDigitsAfterDecimal
%= 256;
3349 if (nNumDigitsAfterDecimal
== -1)
3350 nNumDigitsAfterDecimal
= LocaleDataWrapper::getNumDigits();
3352 bool bIncludeLeadingDigit
= LocaleDataWrapper::isNumLeadingZero();
3353 if (nArgCount
> 3 && !rPar
.Get(3)->IsEmpty())
3355 switch (rPar
.Get(3)->GetInteger())
3357 case ooo::vba::VbTriState::vbFalse
:
3358 bIncludeLeadingDigit
= false;
3360 case ooo::vba::VbTriState::vbTrue
:
3361 bIncludeLeadingDigit
= true;
3363 case ooo::vba::VbTriState::vbUseDefault
:
3367 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT
);
3372 bool bUseParensForNegativeNumbers
= false;
3373 if (nArgCount
> 4 && !rPar
.Get(4)->IsEmpty())
3375 switch (rPar
.Get(4)->GetInteger())
3377 case ooo::vba::VbTriState::vbFalse
:
3378 case ooo::vba::VbTriState::vbUseDefault
:
3381 case ooo::vba::VbTriState::vbTrue
:
3382 bUseParensForNegativeNumbers
= true;
3385 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT
);
3390 bool bGroupDigits
= false;
3391 if (nArgCount
> 5 && !rPar
.Get(5)->IsEmpty())
3393 switch (rPar
.Get(5)->GetInteger())
3395 case ooo::vba::VbTriState::vbFalse
:
3396 case ooo::vba::VbTriState::vbUseDefault
:
3399 case ooo::vba::VbTriState::vbTrue
:
3400 bGroupDigits
= true;
3403 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT
);
3408 double fVal
= rPar
.Get(1)->GetDouble();
3409 const bool bNegative
= fVal
< 0;
3411 fVal
= fabs(fVal
); // Always work with non-negatives, to easily handle leading zero
3413 static const sal_Unicode decSep
= localeData
.getNumDecimalSep().toChar();
3414 OUString aResult
= rtl::math::doubleToUString(
3415 fVal
, rtl_math_StringFormat_F
, nNumDigitsAfterDecimal
, decSep
,
3416 bGroupDigits
? localeData
.getDigitGrouping().getConstArray() : nullptr,
3417 localeData
.getNumThousandSep().toChar());
3419 if (!bIncludeLeadingDigit
&& aResult
.getLength() > 1 && aResult
.startsWith("0"))
3420 aResult
= aResult
.copy(1);
3422 if (nNumDigitsAfterDecimal
> 0)
3424 sal_Int32 nActualDigits
= nNumDigitsAfterDecimal
;
3425 const sal_Int32 nSepPos
= aResult
.indexOf(decSep
);
3429 nActualDigits
= aResult
.getLength() - nSepPos
- 1;
3431 // VBA allows up to 255 digits; rtl::math::doubleToUString outputs up to 15 digits
3432 // for ~small numbers, so pad them as appropriate.
3433 if (nActualDigits
< nNumDigitsAfterDecimal
)
3435 OUStringBuffer sBuf
;
3436 comphelper::string::padToLength(sBuf
, nNumDigitsAfterDecimal
- nActualDigits
, '0');
3443 if (bUseParensForNegativeNumbers
)
3444 aResult
= "(" + aResult
+ ")";
3446 aResult
= "-" + aResult
;
3449 rPar
.Get(0)->PutString(aResult
);
3454 // note: BASIC does not use comphelper::random, because
3455 // Randomize(int) must be supported and should not affect non-BASIC random use
3456 struct RandomNumberGenerator
3458 std::mt19937 global_rng
;
3460 RandomNumberGenerator()
3464 std::random_device rd
;
3465 // initialises the state of the global random number generator
3466 // should only be called once.
3467 // (note, a few std::variate_generator<> (like normal) have their
3468 // own state which would need a reset as well to guarantee identical
3469 // sequence of numbers, e.g. via myrand.distribution().reset())
3470 global_rng
.seed(rd() ^ time(nullptr));
3472 catch (std::runtime_error
& e
)
3474 SAL_WARN("basic", "Using std::random_device failed: " << e
.what());
3475 global_rng
.seed(time(nullptr));
3480 class theRandomNumberGenerator
: public rtl::Static
<RandomNumberGenerator
, theRandomNumberGenerator
> {};
3484 void SbRtl_Randomize(StarBASIC
*, SbxArray
& rPar
, bool)
3486 if ( rPar
.Count() > 2 )
3488 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3490 if( rPar
.Count() == 2 )
3492 int nSeed
= static_cast<int>(rPar
.Get(1)->GetInteger());
3493 theRandomNumberGenerator::get().global_rng
.seed(nSeed
);
3495 // without parameter, no need to do anything - RNG is seeded at first use
3498 void SbRtl_Rnd(StarBASIC
*, SbxArray
& rPar
, bool)
3500 if ( rPar
.Count() > 2 )
3502 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3506 std::uniform_real_distribution
<double> dist(0.0, 1.0);
3507 double const tmp(dist(theRandomNumberGenerator::get().global_rng
));
3508 rPar
.Get(0)->PutDouble(tmp
);
3513 // Syntax: Shell("Path",[ Window-Style,[ "Params", [ bSync = sal_False ]]])
3514 // WindowStyles (VBA compatible):
3517 // 10 == Full-Screen (text mode applications OS/2, WIN95, WNT)
3518 // HACK: The WindowStyle will be passed to
3519 // Application::StartApp in Creator. Format: "xxxx2"
3522 void SbRtl_Shell(StarBASIC
*, SbxArray
& rPar
, bool)
3524 std::size_t nArgCount
= rPar
.Count();
3525 if ( nArgCount
< 2 || nArgCount
> 5 )
3527 rPar
.Get(0)->PutLong(0);
3528 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3532 oslProcessOption nOptions
= osl_Process_SEARCHPATH
| osl_Process_DETACHED
;
3534 OUString aCmdLine
= rPar
.Get(1)->GetOUString();
3535 // attach additional parameters - everything must be parsed anyway
3536 if( nArgCount
>= 4 )
3538 OUString tmp
= rPar
.Get(3)->GetOUString().trim();
3541 aCmdLine
+= " " + tmp
;
3544 else if( aCmdLine
.isEmpty() )
3546 // avoid special treatment (empty list)
3549 sal_Int32 nLen
= aCmdLine
.getLength();
3551 // #55735 if there are parameters, they have to be separated
3552 // #72471 also separate the single parameters
3553 std::vector
<OUString
> aTokenVector
;
3562 if ( c
!= ' ' && c
!= '\t' )
3568 if( c
== '\"' || c
== '\'' )
3570 sal_Int32 iFoundPos
= aCmdLine
.indexOf( c
, i
+ 1 );
3574 aToken
= aCmdLine
.copy( i
);
3579 aToken
= aCmdLine
.copy( i
+ 1, (iFoundPos
- i
- 1) );
3585 sal_Int32 iFoundSpacePos
= aCmdLine
.indexOf( ' ', i
);
3586 sal_Int32 iFoundTabPos
= aCmdLine
.indexOf( '\t', i
);
3587 sal_Int32 iFoundPos
= iFoundSpacePos
>= 0 ? iFoundTabPos
>= 0 ? std::min( iFoundSpacePos
, iFoundTabPos
) : iFoundSpacePos
: -1;
3591 aToken
= aCmdLine
.copy( i
);
3596 aToken
= aCmdLine
.copy( i
, (iFoundPos
- i
) );
3601 // insert into the list
3602 aTokenVector
.push_back( aToken
);
3604 // #55735 / #72471 end
3606 sal_Int16 nWinStyle
= 0;
3607 if( nArgCount
>= 3 )
3609 nWinStyle
= rPar
.Get(2)->GetInteger();
3613 nOptions
|= osl_Process_MINIMIZED
;
3616 nOptions
|= osl_Process_MAXIMIZED
;
3619 nOptions
|= osl_Process_FULLSCREEN
;
3624 if( nArgCount
>= 5 )
3626 bSync
= rPar
.Get(4)->GetBool();
3630 nOptions
|= osl_Process_WAIT
;
3634 // #72471 work parameter(s) up
3635 std::vector
<OUString
>::const_iterator iter
= aTokenVector
.begin();
3636 OUString aOUStrProgURL
= getFullPath( *iter
);
3640 sal_uInt16 nParamCount
= sal::static_int_cast
< sal_uInt16
>(aTokenVector
.size() - 1 );
3641 std::unique_ptr
<rtl_uString
*[]> pParamList
;
3644 pParamList
.reset( new rtl_uString
*[nParamCount
]);
3645 for(int iVector
= 0; iter
!= aTokenVector
.end(); ++iVector
, ++iter
)
3647 const OUString
& rParamStr
= *iter
;
3648 pParamList
[iVector
] = nullptr;
3649 rtl_uString_assign(&(pParamList
[iVector
]), rParamStr
.pData
);
3654 bool bSucc
= osl_executeProcess(
3655 aOUStrProgURL
.pData
,
3662 &pApp
) == osl_Process_E_None
;
3664 // 53521 only free process handle on success
3667 osl_freeProcessHandle( pApp
);
3670 for(int j
= 0; j
< nParamCount
; ++j
)
3672 rtl_uString_release(pParamList
[j
]);
3677 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND
);
3681 rPar
.Get(0)->PutLong( 0 );
3686 void SbRtl_VarType(StarBASIC
*, SbxArray
& rPar
, bool)
3688 if ( rPar
.Count() != 2 )
3690 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3694 SbxDataType eType
= rPar
.Get(1)->GetType();
3695 rPar
.Get(0)->PutInteger( static_cast<sal_Int16
>(eType
) );
3699 // Exported function
3700 OUString
getBasicTypeName( SbxDataType eType
)
3702 static const char* pTypeNames
[] =
3704 "Empty", // SbxEMPTY
3706 "Integer", // SbxINTEGER
3708 "Single", // SbxSINGLE
3709 "Double", // SbxDOUBLE
3710 "Currency", // SbxCURRENCY
3712 "String", // SbxSTRING
3713 "Object", // SbxOBJECT
3714 "Error", // SbxERROR
3715 "Boolean", // SbxBOOL
3716 "Variant", // SbxVARIANT
3717 "DataObject", // SbxDATAOBJECT
3722 "UShort", // SbxUSHORT
3723 "ULong", // SbxULONG
3724 "Long64", // SbxLONG64
3725 "ULong64", // SbxULONG64
3729 "HResult", // SbxHRESULT
3730 "Pointer", // SbxPOINTER
3731 "DimArray", // SbxDIMARRAY
3732 "CArray", // SbxCARRAY
3733 "Userdef", // SbxUSERDEF
3734 "Lpstr", // SbxLPSTR
3735 "Lpwstr", // SbxLPWSTR
3736 "Unknown Type", // SbxCoreSTRING
3737 "WString", // SbxWSTRING
3738 "WChar", // SbxWCHAR
3739 "Int64", // SbxSALINT64
3740 "UInt64", // SbxSALUINT64
3741 "Decimal", // SbxDECIMAL
3744 size_t nPos
= static_cast<size_t>(eType
) & 0x0FFF;
3745 const size_t nTypeNameCount
= SAL_N_ELEMENTS( pTypeNames
);
3746 if ( nPos
>= nTypeNameCount
)
3748 nPos
= nTypeNameCount
- 1;
3750 return OUString::createFromAscii(pTypeNames
[nPos
]);
3753 static OUString
getObjectTypeName( SbxVariable
* pVar
)
3755 OUString
sRet( "Object" );
3758 SbxBase
* pBaseObj
= pVar
->GetObject();
3765 SbUnoObject
* pUnoObj
= dynamic_cast<SbUnoObject
*>( pVar
);
3768 pUnoObj
= dynamic_cast<SbUnoObject
*>( pBaseObj
);
3772 Any aObj
= pUnoObj
->getUnoAny();
3773 // For upstreaming unless we start to build oovbaapi by default
3774 // we need to get detect the vba-ness of the object in some
3776 // note: Automation objects do not support XServiceInfo
3777 uno::Reference
< XServiceInfo
> xServInfo( aObj
, uno::UNO_QUERY
);
3778 if ( xServInfo
.is() )
3780 // is this a VBA object ?
3781 Sequence
< OUString
> sServices
= xServInfo
->getSupportedServiceNames();
3782 if ( sServices
.hasElements() )
3784 sRet
= sServices
[ 0 ];
3789 uno::Reference
< bridge::oleautomation::XAutomationObject
> xAutoMation( aObj
, uno::UNO_QUERY
);
3790 if ( xAutoMation
.is() )
3792 uno::Reference
< script::XInvocation
> xInv( aObj
, uno::UNO_QUERY
);
3797 xInv
->getValue( "$GetTypeName" ) >>= sRet
;
3799 catch(const Exception
& )
3805 sal_Int32 nDot
= sRet
.lastIndexOf( '.' );
3806 if ( nDot
!= -1 && nDot
< sRet
.getLength() )
3808 sRet
= sRet
.copy( nDot
+ 1 );
3816 void SbRtl_TypeName(StarBASIC
*, SbxArray
& rPar
, bool)
3818 if ( rPar
.Count() != 2 )
3820 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3824 SbxDataType eType
= rPar
.Get(1)->GetType();
3825 bool bIsArray
= ( ( eType
& SbxARRAY
) != 0 );
3828 if ( SbiRuntime::isVBAEnabled() && eType
== SbxOBJECT
)
3830 aRetStr
= getObjectTypeName( rPar
.Get(1) );
3834 aRetStr
= getBasicTypeName( eType
);
3840 rPar
.Get(0)->PutString( aRetStr
);
3844 void SbRtl_Len(StarBASIC
*, SbxArray
& rPar
, bool)
3846 if ( rPar
.Count() != 2 )
3848 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3852 const OUString
& rStr
= rPar
.Get(1)->GetOUString();
3853 rPar
.Get(0)->PutLong( rStr
.getLength() );
3857 void SbRtl_DDEInitiate(StarBASIC
*, SbxArray
& rPar
, bool)
3859 int nArgs
= static_cast<int>(rPar
.Count());
3862 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3865 const OUString
& rApp
= rPar
.Get(1)->GetOUString();
3866 const OUString
& rTopic
= rPar
.Get(2)->GetOUString();
3868 SbiDdeControl
* pDDE
= GetSbData()->pInst
->GetDdeControl();
3870 ErrCode nDdeErr
= pDDE
->Initiate( rApp
, rTopic
, nChannel
);
3873 StarBASIC::Error( nDdeErr
);
3877 rPar
.Get(0)->PutInteger( static_cast<sal_Int16
>(nChannel
) );
3881 void SbRtl_DDETerminate(StarBASIC
*, SbxArray
& rPar
, bool)
3883 rPar
.Get(0)->PutEmpty();
3884 int nArgs
= static_cast<int>(rPar
.Count());
3887 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3890 size_t nChannel
= rPar
.Get(1)->GetInteger();
3891 SbiDdeControl
* pDDE
= GetSbData()->pInst
->GetDdeControl();
3892 ErrCode nDdeErr
= pDDE
->Terminate( nChannel
);
3895 StarBASIC::Error( nDdeErr
);
3899 void SbRtl_DDETerminateAll(StarBASIC
*, SbxArray
& rPar
, bool)
3901 rPar
.Get(0)->PutEmpty();
3902 int nArgs
= static_cast<int>(rPar
.Count());
3905 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3909 SbiDdeControl
* pDDE
= GetSbData()->pInst
->GetDdeControl();
3910 ErrCode nDdeErr
= pDDE
->TerminateAll();
3913 StarBASIC::Error( nDdeErr
);
3917 void SbRtl_DDERequest(StarBASIC
*, SbxArray
& rPar
, bool)
3919 int nArgs
= static_cast<int>(rPar
.Count());
3922 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3925 size_t nChannel
= rPar
.Get(1)->GetInteger();
3926 const OUString
& rItem
= rPar
.Get(2)->GetOUString();
3927 SbiDdeControl
* pDDE
= GetSbData()->pInst
->GetDdeControl();
3929 ErrCode nDdeErr
= pDDE
->Request( nChannel
, rItem
, aResult
);
3932 StarBASIC::Error( nDdeErr
);
3936 rPar
.Get(0)->PutString( aResult
);
3940 void SbRtl_DDEExecute(StarBASIC
*, SbxArray
& rPar
, bool)
3942 rPar
.Get(0)->PutEmpty();
3943 int nArgs
= static_cast<int>(rPar
.Count());
3946 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3949 size_t nChannel
= rPar
.Get(1)->GetInteger();
3950 const OUString
& rCommand
= rPar
.Get(2)->GetOUString();
3951 SbiDdeControl
* pDDE
= GetSbData()->pInst
->GetDdeControl();
3952 ErrCode nDdeErr
= pDDE
->Execute( nChannel
, rCommand
);
3955 StarBASIC::Error( nDdeErr
);
3959 void SbRtl_DDEPoke(StarBASIC
*, SbxArray
& rPar
, bool)
3961 rPar
.Get(0)->PutEmpty();
3962 int nArgs
= static_cast<int>(rPar
.Count());
3965 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3968 size_t nChannel
= rPar
.Get(1)->GetInteger();
3969 const OUString
& rItem
= rPar
.Get(2)->GetOUString();
3970 const OUString
& rData
= rPar
.Get(3)->GetOUString();
3971 SbiDdeControl
* pDDE
= GetSbData()->pInst
->GetDdeControl();
3972 ErrCode nDdeErr
= pDDE
->Poke( nChannel
, rItem
, rData
);
3975 StarBASIC::Error( nDdeErr
);
3980 void SbRtl_FreeFile(StarBASIC
*, SbxArray
& rPar
, bool)
3982 if ( rPar
.Count() != 1 )
3984 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
3987 SbiIoSystem
* pIO
= GetSbData()->pInst
->GetIoSystem();
3989 while( nChannel
< CHANNELS
)
3991 SbiStream
* pStrm
= pIO
->GetStream( nChannel
);
3994 rPar
.Get(0)->PutInteger( nChannel
);
3999 StarBASIC::Error( ERRCODE_BASIC_TOO_MANY_FILES
);
4002 void SbRtl_LBound(StarBASIC
*, SbxArray
& rPar
, bool)
4004 sal_uInt16 nParCount
= rPar
.Count();
4005 if ( nParCount
!= 3 && nParCount
!= 2 )
4007 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4010 SbxBase
* pParObj
= rPar
.Get(1)->GetObject();
4011 SbxDimArray
* pArr
= dynamic_cast<SbxDimArray
*>( pParObj
);
4014 sal_Int32 nLower
, nUpper
;
4015 short nDim
= (nParCount
== 3) ? static_cast<short>(rPar
.Get(2)->GetInteger()) : 1;
4016 if( !pArr
->GetDim32( nDim
, nLower
, nUpper
) )
4017 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
4019 rPar
.Get(0)->PutLong( nLower
);
4022 StarBASIC::Error( ERRCODE_BASIC_MUST_HAVE_DIMS
);
4025 void SbRtl_UBound(StarBASIC
*, SbxArray
& rPar
, bool)
4027 sal_uInt16 nParCount
= rPar
.Count();
4028 if ( nParCount
!= 3 && nParCount
!= 2 )
4030 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4034 SbxBase
* pParObj
= rPar
.Get(1)->GetObject();
4035 SbxDimArray
* pArr
= dynamic_cast<SbxDimArray
*>( pParObj
);
4038 sal_Int32 nLower
, nUpper
;
4039 short nDim
= (nParCount
== 3) ? static_cast<short>(rPar
.Get(2)->GetInteger()) : 1;
4040 if( !pArr
->GetDim32( nDim
, nLower
, nUpper
) )
4041 StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE
);
4043 rPar
.Get(0)->PutLong( nUpper
);
4046 StarBASIC::Error( ERRCODE_BASIC_MUST_HAVE_DIMS
);
4049 void SbRtl_RGB(StarBASIC
*, SbxArray
& rPar
, bool)
4051 if ( rPar
.Count() != 4 )
4053 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4057 sal_Int32 nRed
= rPar
.Get(1)->GetInteger() & 0xFF;
4058 sal_Int32 nGreen
= rPar
.Get(2)->GetInteger() & 0xFF;
4059 sal_Int32 nBlue
= rPar
.Get(3)->GetInteger() & 0xFF;
4062 SbiInstance
* pInst
= GetSbData()->pInst
;
4063 bool bCompatibility
= ( pInst
&& pInst
->IsCompatibility() );
4064 if( bCompatibility
)
4066 nRGB
= (nBlue
<< 16) | (nGreen
<< 8) | nRed
;
4070 nRGB
= (nRed
<< 16) | (nGreen
<< 8) | nBlue
;
4072 rPar
.Get(0)->PutLong( nRGB
);
4075 void SbRtl_QBColor(StarBASIC
*, SbxArray
& rPar
, bool)
4077 static const sal_Int32 pRGB
[] =
4097 if ( rPar
.Count() != 2 )
4099 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4103 sal_Int16 nCol
= rPar
.Get(1)->GetInteger();
4104 if( nCol
< 0 || nCol
> 15 )
4106 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4109 sal_Int32 nRGB
= pRGB
[ nCol
];
4110 rPar
.Get(0)->PutLong( nRGB
);
4113 // StrConv(string, conversion, LCID)
4114 void SbRtl_StrConv(StarBASIC
*, SbxArray
& rPar
, bool)
4116 std::size_t nArgCount
= rPar
.Count()-1;
4117 if( nArgCount
< 2 || nArgCount
> 3 )
4119 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4123 OUString aOldStr
= rPar
.Get(1)->GetOUString();
4124 sal_Int32 nConversion
= rPar
.Get(2)->GetLong();
4126 LanguageType nLanguage
= LANGUAGE_SYSTEM
;
4128 sal_Int32 nOldLen
= aOldStr
.getLength();
4131 // null string,return
4132 rPar
.Get(0)->PutString(aOldStr
);
4136 TransliterationFlags nType
= TransliterationFlags::NONE
;
4137 if ( (nConversion
& 0x03) == 3 ) // vbProperCase
4139 const CharClass
& rCharClass
= GetCharClass();
4140 aOldStr
= rCharClass
.titlecase( aOldStr
.toAsciiLowerCase(), 0, nOldLen
);
4142 else if ( (nConversion
& 0x01) == 1 ) // vbUpperCase
4144 nType
|= TransliterationFlags::LOWERCASE_UPPERCASE
;
4146 else if ( (nConversion
& 0x02) == 2 ) // vbLowerCase
4148 nType
|= TransliterationFlags::UPPERCASE_LOWERCASE
;
4150 if ( (nConversion
& 0x04) == 4 ) // vbWide
4152 nType
|= TransliterationFlags::HALFWIDTH_FULLWIDTH
;
4154 else if ( (nConversion
& 0x08) == 8 ) // vbNarrow
4156 nType
|= TransliterationFlags::FULLWIDTH_HALFWIDTH
;
4158 if ( (nConversion
& 0x10) == 16) // vbKatakana
4160 nType
|= TransliterationFlags::HIRAGANA_KATAKANA
;
4162 else if ( (nConversion
& 0x20) == 32 ) // vbHiragana
4164 nType
|= TransliterationFlags::KATAKANA_HIRAGANA
;
4166 OUString
aNewStr( aOldStr
);
4167 if( nType
!= TransliterationFlags::NONE
)
4169 uno::Reference
< uno::XComponentContext
> xContext
= getProcessComponentContext();
4170 ::utl::TransliterationWrapper
aTransliterationWrapper( xContext
, nType
);
4171 uno::Sequence
<sal_Int32
> aOffsets
;
4172 aTransliterationWrapper
.loadModuleIfNeeded( nLanguage
);
4173 aNewStr
= aTransliterationWrapper
.transliterate( aOldStr
, nLanguage
, 0, nOldLen
, &aOffsets
);
4176 if ( (nConversion
& 0x40) == 64 ) // vbUnicode
4178 // convert the string to byte string, preserving unicode (2 bytes per character)
4179 sal_Int32 nSize
= aNewStr
.getLength()*2;
4180 const sal_Unicode
* pSrc
= aNewStr
.getStr();
4181 std::unique_ptr
<sal_Char
[]> pChar(new sal_Char
[nSize
+1]);
4182 for( sal_Int32 i
=0; i
< nSize
; i
++ )
4184 pChar
[i
] = static_cast< sal_Char
>( (i
%2) ? ((*pSrc
) >> 8) & 0xff : (*pSrc
) & 0xff );
4190 pChar
[nSize
] = '\0';
4191 OString
aOStr(pChar
.get());
4193 // there is no concept about default codepage in unix. so it is incorrectly in unix
4194 OUString aOUStr
= OStringToOUString(aOStr
, osl_getThreadTextEncoding());
4195 rPar
.Get(0)->PutString( aOUStr
);
4198 else if ( (nConversion
& 0x80) == 128 ) // vbFromUnicode
4200 // there is no concept about default codepage in unix. so it is incorrectly in unix
4201 OString aOStr
= OUStringToOString(aNewStr
,osl_getThreadTextEncoding());
4202 const sal_Char
* pChar
= aOStr
.getStr();
4203 sal_Int32 nArraySize
= aOStr
.getLength();
4204 SbxDimArray
* pArray
= new SbxDimArray(SbxBYTE
);
4205 bool bIncIndex
= (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() );
4210 pArray
->AddDim( 1, nArraySize
);
4214 pArray
->AddDim( 0, nArraySize
-1 );
4219 pArray
->unoAddDim( 0, -1 );
4222 for( sal_Int32 i
=0; i
< nArraySize
; i
++)
4224 SbxVariable
* pNew
= new SbxVariable( SbxBYTE
);
4225 pNew
->PutByte(*pChar
);
4227 pNew
->SetFlag( SbxFlagBits::Write
);
4234 pArray
->Put(pNew
, aIdx
);
4237 SbxVariableRef refVar
= rPar
.Get(0);
4238 SbxFlagBits nFlags
= refVar
->GetFlags();
4239 refVar
->ResetFlag( SbxFlagBits::Fixed
);
4240 refVar
->PutObject( pArray
);
4241 refVar
->SetFlags( nFlags
);
4242 refVar
->SetParameters( nullptr );
4245 rPar
.Get(0)->PutString(aNewStr
);
4249 void SbRtl_Beep(StarBASIC
*, SbxArray
& rPar
, bool)
4251 if ( rPar
.Count() != 1 )
4253 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4259 void SbRtl_Load(StarBASIC
*, SbxArray
& rPar
, bool)
4261 if( rPar
.Count() != 2 )
4263 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4268 SbxBase
* pObj
= rPar
.Get(1)->GetObject();
4271 if (SbUserFormModule
* pModule
= dynamic_cast<SbUserFormModule
*>(pObj
))
4275 else if (SbxObject
* pSbxObj
= dynamic_cast<SbxObject
*>(pObj
))
4277 SbxVariable
* pVar
= pSbxObj
->Find("Load", SbxClassType::Method
);
4286 void SbRtl_Unload(StarBASIC
*, SbxArray
& rPar
, bool)
4288 rPar
.Get(0)->PutEmpty();
4289 if( rPar
.Count() != 2 )
4291 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4296 SbxBase
* pObj
= rPar
.Get(1)->GetObject();
4299 if (SbUserFormModule
* pFormModule
= dynamic_cast<SbUserFormModule
*>(pObj
))
4301 pFormModule
->Unload();
4303 else if (SbxObject
*pSbxObj
= dynamic_cast<SbxObject
*>(pObj
))
4305 SbxVariable
* pVar
= pSbxObj
->Find("Unload", SbxClassType::Method
);
4314 void SbRtl_LoadPicture(StarBASIC
*, SbxArray
& rPar
, bool)
4316 if( rPar
.Count() != 2 )
4318 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4322 OUString aFileURL
= getFullPath( rPar
.Get(1)->GetOUString() );
4323 std::unique_ptr
<SvStream
> pStream(utl::UcbStreamHelper::CreateStream( aFileURL
, StreamMode::READ
));
4327 ReadDIB(aBmp
, *pStream
, true);
4328 Graphic
aGraphic(aBmp
);
4330 SbxObjectRef xRef
= new SbStdPicture
;
4331 static_cast<SbStdPicture
*>(xRef
.get())->SetGraphic( aGraphic
);
4332 rPar
.Get(0)->PutObject( xRef
.get() );
4336 void SbRtl_SavePicture(StarBASIC
*, SbxArray
& rPar
, bool)
4338 rPar
.Get(0)->PutEmpty();
4339 if( rPar
.Count() != 3 )
4341 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4345 SbxBase
* pObj
= rPar
.Get(1)->GetObject();
4346 if (SbStdPicture
*pPicture
= dynamic_cast<SbStdPicture
*>(pObj
))
4348 SvFileStream
aOStream( rPar
.Get(2)->GetOUString(), StreamMode::WRITE
| StreamMode::TRUNC
);
4349 const Graphic
& aGraphic
= pPicture
->GetGraphic();
4350 WriteGraphic( aOStream
, aGraphic
);
4354 void SbRtl_MsgBox(StarBASIC
*, SbxArray
& rPar
, bool)
4356 sal_uInt16 nArgCount
= rPar
.Count();
4357 if( nArgCount
< 2 || nArgCount
> 6 )
4359 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4362 WinBits nType
= 0; // MB_OK
4363 if( nArgCount
>= 3 )
4364 nType
= static_cast<WinBits
>(rPar
.Get(2)->GetInteger());
4365 WinBits nStyle
= nType
;
4366 nStyle
&= 15; // delete bits 4-16
4381 OUString aMsg
= rPar
.Get(1)->GetOUString();
4383 if( nArgCount
>= 4 )
4385 aTitle
= rPar
.Get(3)->GetOUString();
4389 aTitle
= Application::GetDisplayName();
4392 WinBits nDialogType
= nType
& (16+32+64);
4394 SolarMutexGuard aSolarGuard
;
4395 vcl::Window
* pParentWin
= Application::GetDefDialogParent();
4396 weld::Widget
* pParent
= pParentWin
? pParentWin
->GetFrameWeld() : nullptr;
4398 VclMessageType eType
= VclMessageType::Info
;
4400 switch (nDialogType
)
4403 eType
= VclMessageType::Error
;
4406 eType
= VclMessageType::Question
;
4409 eType
= VclMessageType::Warning
;
4413 eType
= VclMessageType::Info
;
4417 std::unique_ptr
<weld::MessageDialog
> xBox(Application::CreateMessageDialog(pParent
,
4418 eType
, VclButtonsType::NONE
, aMsg
));
4424 xBox
->add_button(GetStandardText(StandardButtonType::OK
), BasicResponse::Ok
);
4426 case 1: // MB_OKCANCEL
4427 xBox
->add_button(GetStandardText(StandardButtonType::OK
), BasicResponse::Ok
);
4428 xBox
->add_button(GetStandardText(StandardButtonType::Cancel
), BasicResponse::Cancel
);
4430 if (nType
& 256 || nType
& 512)
4431 xBox
->set_default_response(BasicResponse::Cancel
);
4433 xBox
->set_default_response(BasicResponse::Ok
);
4436 case 2: // MB_ABORTRETRYIGNORE
4437 xBox
->add_button(GetStandardText(StandardButtonType::Abort
), BasicResponse::Abort
);
4438 xBox
->add_button(GetStandardText(StandardButtonType::Retry
), BasicResponse::Retry
);
4439 xBox
->add_button(GetStandardText(StandardButtonType::Ignore
), BasicResponse::Ignore
);
4442 xBox
->set_default_response(BasicResponse::Retry
);
4443 else if (nType
& 512)
4444 xBox
->set_default_response(BasicResponse::Ignore
);
4446 xBox
->set_default_response(BasicResponse::Cancel
);
4449 case 3: // MB_YESNOCANCEL
4450 xBox
->add_button(GetStandardText(StandardButtonType::Yes
), BasicResponse::Yes
);
4451 xBox
->add_button(GetStandardText(StandardButtonType::No
), BasicResponse::No
);
4452 xBox
->add_button(GetStandardText(StandardButtonType::Cancel
), BasicResponse::Cancel
);
4454 if (nType
& 256 || nType
& 512)
4455 xBox
->set_default_response(BasicResponse::Cancel
);
4457 xBox
->set_default_response(BasicResponse::Yes
);
4461 xBox
->add_button(GetStandardText(StandardButtonType::Yes
), BasicResponse::Yes
);
4462 xBox
->add_button(GetStandardText(StandardButtonType::No
), BasicResponse::No
);
4464 if (nType
& 256 || nType
& 512)
4465 xBox
->set_default_response(BasicResponse::No
);
4467 xBox
->set_default_response(BasicResponse::Yes
);
4470 case 5: // MB_RETRYCANCEL
4471 xBox
->add_button(GetStandardText(StandardButtonType::Retry
), BasicResponse::Retry
);
4472 xBox
->add_button(GetStandardText(StandardButtonType::Cancel
), BasicResponse::Cancel
);
4474 if (nType
& 256 || nType
& 512)
4475 xBox
->set_default_response(BasicResponse::Cancel
);
4477 xBox
->set_default_response(BasicResponse::Retry
);
4482 xBox
->set_title(aTitle
);
4483 sal_Int16 nRet
= xBox
->run();
4484 rPar
.Get(0)->PutInteger(nRet
);
4487 void SbRtl_SetAttr(StarBASIC
*, SbxArray
& rPar
, bool)
4489 rPar
.Get(0)->PutEmpty();
4490 if ( rPar
.Count() == 3 )
4492 OUString aStr
= rPar
.Get(1)->GetOUString();
4493 SbAttributes nFlags
= static_cast<SbAttributes
>( rPar
.Get(2)->GetInteger() );
4497 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
4502 bool bReadOnly
= bool(nFlags
& SbAttributes::READONLY
);
4503 xSFI
->setReadOnly( aStr
, bReadOnly
);
4504 bool bHidden
= bool(nFlags
& SbAttributes::HIDDEN
);
4505 xSFI
->setHidden( aStr
, bHidden
);
4507 catch(const Exception
& )
4509 StarBASIC::Error( ERRCODE_IO_GENERAL
);
4516 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4520 void SbRtl_Reset(StarBASIC
*, SbxArray
&, bool)
4522 SbiIoSystem
* pIO
= GetSbData()->pInst
->GetIoSystem();
4529 void SbRtl_DumpAllObjects(StarBASIC
* pBasic
, SbxArray
& rPar
, bool)
4531 sal_uInt16 nArgCount
= rPar
.Count();
4532 if( nArgCount
< 2 || nArgCount
> 3 )
4534 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4538 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR
);
4542 SbxObject
* p
= pBasic
;
4543 while( p
->GetParent() )
4547 SvFileStream
aStrm( rPar
.Get( 1 )->GetOUString(),
4548 StreamMode::WRITE
| StreamMode::TRUNC
);
4549 p
->Dump( aStrm
, rPar
.Get( 2 )->GetBool() );
4551 if( aStrm
.GetError() != ERRCODE_NONE
)
4553 StarBASIC::Error( ERRCODE_BASIC_IO_ERROR
);
4559 void SbRtl_FileExists(StarBASIC
*, SbxArray
& rPar
, bool)
4561 if ( rPar
.Count() == 2 )
4563 OUString aStr
= rPar
.Get(1)->GetOUString();
4564 bool bExists
= false;
4568 const uno::Reference
< ucb::XSimpleFileAccess3
>& xSFI
= getFileAccess();
4573 bExists
= xSFI
->exists( aStr
);
4575 catch(const Exception
& )
4577 StarBASIC::Error( ERRCODE_IO_GENERAL
);
4583 DirectoryItem aItem
;
4584 FileBase::RC nRet
= DirectoryItem::get( getFullPath( aStr
), aItem
);
4585 bExists
= (nRet
== FileBase::E_None
);
4587 rPar
.Get(0)->PutBool( bExists
);
4591 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4595 void SbRtl_Partition(StarBASIC
*, SbxArray
& rPar
, bool)
4597 if ( rPar
.Count() != 5 )
4599 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4603 sal_Int32 nNumber
= rPar
.Get(1)->GetLong();
4604 sal_Int32 nStart
= rPar
.Get(2)->GetLong();
4605 sal_Int32 nStop
= rPar
.Get(3)->GetLong();
4606 sal_Int32 nInterval
= rPar
.Get(4)->GetLong();
4608 if( nStart
< 0 || nStop
<= nStart
|| nInterval
< 1 )
4610 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4614 // the Partition function inserts leading spaces before lowervalue and uppervalue
4615 // so that they both have the same number of characters as the string
4616 // representation of the value (Stop + 1). This ensures that if you use the output
4617 // of the Partition function with several values of Number, the resulting text
4618 // will be handled properly during any subsequent sort operation.
4620 // calculate the maximum number of characters before lowervalue and uppervalue
4621 OUString aBeforeStart
= OUString::number( nStart
- 1 );
4622 OUString aAfterStop
= OUString::number( nStop
+ 1 );
4623 sal_Int32 nLen1
= aBeforeStart
.getLength();
4624 sal_Int32 nLen2
= aAfterStop
.getLength();
4625 sal_Int32 nLen
= nLen1
>= nLen2
? nLen1
:nLen2
;
4627 OUStringBuffer
aRetStr( nLen
* 2 + 1);
4628 OUString aLowerValue
;
4629 OUString aUpperValue
;
4630 if( nNumber
< nStart
)
4632 aUpperValue
= aBeforeStart
;
4634 else if( nNumber
> nStop
)
4636 aLowerValue
= aAfterStop
;
4640 sal_Int32 nLowerValue
= nNumber
;
4641 sal_Int32 nUpperValue
= nLowerValue
;
4644 nLowerValue
= ((( nNumber
- nStart
) / nInterval
) * nInterval
) + nStart
;
4645 nUpperValue
= nLowerValue
+ nInterval
- 1;
4647 aLowerValue
= OUString::number( nLowerValue
);
4648 aUpperValue
= OUString::number( nUpperValue
);
4651 nLen1
= aLowerValue
.getLength();
4652 nLen2
= aUpperValue
.getLength();
4656 // appending the leading spaces for the lowervalue
4657 for ( sal_Int32 i
= nLen
- nLen1
; i
> 0; --i
)
4659 aRetStr
.append(" ");
4662 aRetStr
.append( aLowerValue
).append(":");
4665 // appending the leading spaces for the uppervalue
4666 for ( sal_Int32 i
= nLen
- nLen2
; i
> 0; --i
)
4668 aRetStr
.append(" ");
4671 aRetStr
.append( aUpperValue
);
4672 rPar
.Get(0)->PutString( aRetStr
.makeStringAndClear());
4677 static long GetDayDiff( const Date
& rDate
)
4679 Date
aRefDate( 1,1,1900 );
4681 if ( aRefDate
> rDate
)
4683 nDiffDays
= aRefDate
- rDate
;
4688 nDiffDays
= rDate
- aRefDate
;
4690 nDiffDays
+= 2; // adjustment VisualBasic: 1.Jan.1900 == 2
4694 sal_Int16
implGetDateYear( double aDate
)
4696 Date
aRefDate( 1,1,1900 );
4697 long nDays
= static_cast<long>(aDate
);
4698 nDays
-= 2; // standardize: 1.1.1900 => 0.0
4699 aRefDate
.AddDays( nDays
);
4700 sal_Int16 nRet
= aRefDate
.GetYear();
4704 bool implDateSerial( sal_Int16 nYear
, sal_Int16 nMonth
, sal_Int16 nDay
,
4705 bool bUseTwoDigitYear
, SbDateCorrection eCorr
, double& rdRet
)
4707 // XXX NOTE: For VBA years<0 are invalid and years in the range 0..29 and
4708 // 30..99 can not be input as they are 2-digit for 2000..2029 and
4709 // 1930..1999, VBA mode overrides bUseTwoDigitYear (as if that was always
4710 // true). For VBA years > 9999 are invalid.
4711 // For StarBASIC, if bUseTwoDigitYear==true then years in the range 0..99
4712 // can not be input as they are 2-digit for 1900..1999, years<0 are
4713 // accepted. If bUseTwoDigitYear==false then all years are accepted, but
4714 // year 0 is invalid (last day BCE -0001-12-31, first day CE 0001-01-01).
4715 #if HAVE_FEATURE_SCRIPTING
4716 if ( (nYear
< 0 || 9999 < nYear
) && SbiRuntime::isVBAEnabled() )
4718 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4721 else if ( nYear
< 30 && SbiRuntime::isVBAEnabled() )
4728 if ( 0 <= nYear
&& nYear
< 100 && (bUseTwoDigitYear
4729 #if HAVE_FEATURE_SCRIPTING
4730 || SbiRuntime::isVBAEnabled()
4738 sal_Int32 nAddMonths
= 0;
4739 sal_Int32 nAddDays
= 0;
4740 // Always sanitize values to set date and to use for validity detection.
4741 if (nMonth
< 1 || 12 < nMonth
)
4743 sal_Int16 nM
= ((nMonth
< 1) ? (12 + (nMonth
% 12)) : (nMonth
% 12));
4744 nAddMonths
= nMonth
- nM
;
4747 // Day 0 would already be normalized during Date::Normalize(), include
4748 // it in negative days, also to detect non-validity. The actual day of
4749 // month is 1+(nDay-1)
4752 nAddDays
= nDay
- 1;
4757 nAddDays
= nDay
- 31;
4761 Date
aCurDate( nDay
, nMonth
, nYear
);
4763 /* TODO: we could enable the same rollover mechanism for StarBASIC to be
4764 * compatible with VBA (just with our wider supported date range), then
4765 * documentation would need to be adapted. As is, the DateSerial() runtime
4766 * function works as dumb as documented... (except that the resulting date
4767 * is checked for validity now and not just day<=31 and month<=12).
4768 * If change wanted then simply remove overriding RollOver here and adapt
4770 #if HAVE_FEATURE_SCRIPTING
4771 if (eCorr
== SbDateCorrection::RollOver
&& !SbiRuntime::isVBAEnabled())
4772 eCorr
= SbDateCorrection::None
;
4775 if (nYear
== 0 || (eCorr
== SbDateCorrection::None
&& (nAddMonths
|| nAddDays
|| !aCurDate
.IsValidDate())))
4777 #if HAVE_FEATURE_SCRIPTING
4778 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT
);
4783 if (eCorr
!= SbDateCorrection::None
)
4785 aCurDate
.Normalize();
4787 aCurDate
.AddMonths( nAddMonths
);
4789 aCurDate
.AddDays( nAddDays
);
4790 if (eCorr
== SbDateCorrection::TruncateToMonth
&& aCurDate
.GetMonth() != nMonth
)
4792 if (aCurDate
.GetYear() == SAL_MAX_INT16
&& nMonth
== 12)
4794 // Roll over and back not possible, hard max.
4795 aCurDate
.SetMonth(12);
4796 aCurDate
.SetDay(31);
4800 aCurDate
.SetMonth(nMonth
);
4802 aCurDate
.AddMonths(1);
4803 aCurDate
.AddDays(-1);
4808 long nDiffDays
= GetDayDiff( aCurDate
);
4809 rdRet
= static_cast<double>(nDiffDays
);
4813 double implTimeSerial( sal_Int16 nHours
, sal_Int16 nMinutes
, sal_Int16 nSeconds
)
4816 static_cast<double>( nHours
* ::tools::Time::secondPerHour
+
4817 nMinutes
* ::tools::Time::secondPerMinute
+
4820 static_cast<double>( ::tools::Time::secondPerDay
);
4823 bool implDateTimeSerial( sal_Int16 nYear
, sal_Int16 nMonth
, sal_Int16 nDay
,
4824 sal_Int16 nHour
, sal_Int16 nMinute
, sal_Int16 nSecond
,
4828 if(!implDateSerial(nYear
, nMonth
, nDay
, false/*bUseTwoDigitYear*/, SbDateCorrection::None
, dDate
))
4830 rdRet
+= dDate
+ implTimeSerial(nHour
, nMinute
, nSecond
);
4834 sal_Int16
implGetMinute( double dDate
)
4836 double nFrac
= dDate
- floor( dDate
);
4838 sal_Int32 nSeconds
= static_cast<sal_Int32
>(nFrac
+ 0.5);
4839 sal_Int16 nTemp
= static_cast<sal_Int16
>(nSeconds
% 3600);
4840 sal_Int16 nMin
= nTemp
/ 60;
4844 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */