Version 6.4.0.3, tag libreoffice-6.4.0.3
[LibreOffice.git] / basic / source / runtime / methods.cxx
blob4860ec34376d0546a968d5d3d02f07421d2277a7
1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 /*
3 * This file is part of the LibreOffice project.
5 * This Source Code Form is subject to the terms of the Mozilla Public
6 * License, v. 2.0. If a copy of the MPL was not distributed with this
7 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
9 * This file incorporates work covered by the following license notice:
11 * Licensed to the Apache Software Foundation (ASF) under one or more
12 * contributor license agreements. See the NOTICE file distributed
13 * with this work for additional information regarding copyright
14 * ownership. The ASF licenses this file to you under the Apache
15 * License, Version 2.0 (the "License"); you may not use this file
16 * except in compliance with the License. You may obtain a copy of
17 * the License at http://www.apache.org/licenses/LICENSE-2.0 .
20 #include <config_features.h>
22 #include <tools/date.hxx>
23 #include <basic/sbxvar.hxx>
24 #include <basic/sbuno.hxx>
25 #include <osl/process.h>
26 #include <vcl/dibtools.hxx>
27 #include <vcl/window.hxx>
28 #include <vcl/svapp.hxx>
29 #include <vcl/settings.hxx>
30 #include <vcl/sound.hxx>
31 #include <tools/wintypes.hxx>
32 #include <vcl/stdtext.hxx>
33 #include <vcl/weld.hxx>
34 #include <basic/sbx.hxx>
35 #include <svl/zforlist.hxx>
36 #include <rtl/character.hxx>
37 #include <rtl/math.hxx>
38 #include <tools/urlobj.hxx>
39 #include <osl/time.h>
40 #include <unotools/charclass.hxx>
41 #include <unotools/ucbstreamhelper.hxx>
42 #include <tools/wldcrd.hxx>
43 #include <i18nlangtag/lang.h>
44 #include <rtl/string.hxx>
45 #include <sal/log.hxx>
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>
63 #include <memory>
64 #include <random>
65 #include <o3tl/char16_t2wchar_t.hxx>
67 using namespace comphelper;
68 using namespace osl;
69 using namespace com::sun::star;
70 using namespace com::sun::star::lang;
71 using namespace com::sun::star::uno;
73 #include <date.hxx>
74 #include <sbstdobj.hxx>
75 #include <rtlproto.hxx>
76 #include <image.hxx>
77 #include <iosys.hxx>
78 #include "ddectrl.hxx"
79 #include <sbintern.hxx>
80 #include <basic/vbahelper.hxx>
82 #include <vector>
83 #include <math.h>
84 #include <stdio.h>
85 #include <stdlib.h>
86 #include <errno.h>
88 #include <sbobjmod.hxx>
89 #include <sbxmod.hxx>
91 #ifdef _WIN32
92 #include <prewin.h>
93 #include <direct.h>
94 #include <io.h>
95 #include <postwin.h>
96 #else
97 #include <unistd.h>
98 #endif
100 #if HAVE_FEATURE_SCRIPTING
102 static void FilterWhiteSpace( OUString& rStr )
104 if (rStr.isEmpty())
106 return;
108 OUStringBuffer aRet;
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'))
116 aRet.append(cChar);
120 rStr = aRet.makeStringAndClear();
123 static long GetDayDiff( const Date& rDate );
125 static const CharClass& GetCharClass()
127 static CharClass aCharClass( Application::GetSettings().GetLanguageTag() );
128 return aCharClass;
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 )
143 OUString aFileURL;
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 );
154 return aFileURL;
157 // TODO: -> SbiGlobals
158 static uno::Reference< ucb::XSimpleFileAccess3 > const & getFileAccess()
160 static uno::Reference< ucb::XSimpleFileAccess3 > xSFI = ucb::SimpleFileAccess::create( comphelper::getProcessComponentContext() );
161 return xSFI;
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 );
174 if( !p.is() )
175 StarBASIC::Error( ERRCODE_BASIC_CANNOT_LOAD );
176 else
178 // Convenience: enter BASIC as parent
179 p->SetParent( pBasic );
180 rPar.Get( 0 )->PutObject( p.get() );
184 // Error( n )
186 void SbRtl_Error(StarBASIC * pBasic, SbxArray & rPar, bool)
188 if( !pBasic )
189 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
190 else
192 OUString aErrorMsg;
193 ErrCode nErr = ERRCODE_NONE;
194 sal_Int32 nCode = 0;
195 if( rPar.Count() == 1 )
197 nErr = StarBASIC::GetErrBasic();
198 aErrorMsg = StarBASIC::GetErrorMsg();
200 else
202 nCode = rPar.Get( 1 )->GetLong();
203 if( nCode > 65535 )
205 StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
207 else
209 nErr = StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(nCode) );
213 bool bVBA = SbiRuntime::isVBAEnabled();
214 OUString tmpErrMsg;
215 if( bVBA && !aErrorMsg.isEmpty())
217 tmpErrMsg = aErrorMsg;
219 else
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 );
239 // Sinus
241 void SbRtl_Sin(StarBASIC *, SbxArray & rPar, bool)
243 if ( rPar.Count() < 2 )
244 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
245 else
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 );
257 else
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 );
269 else
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 );
283 else
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 );
297 else
299 SbxVariableRef pArg = rPar.Get( 1 );
300 OUString aStr( pArg->GetOUString() );
301 if ( aStr.isEmpty())
303 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
304 rPar.Get(0)->PutEmpty();
306 else
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 );
320 else
322 SbxVariableRef pArg = rPar.Get( 1 );
324 OUString aStr;
325 if( !bChrW && SbiRuntime::isVBAEnabled() )
327 sal_Char c = static_cast<sal_Char>(pArg->GetByte());
328 aStr = OUString(&c, 1, osl_getThreadTextEncoding());
330 else
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*/ );
349 #if defined _WIN32
351 namespace {
353 extern "C" void invalidParameterHandler(
354 wchar_t const * expression, wchar_t const * function, wchar_t const * file, unsigned int line,
355 uintptr_t)
357 SAL_INFO(
358 "basic",
359 "invalid parameter during _wgetdcwd; \"" << (expression ? o3tl::toU(expression) : u"???")
360 << "\" (" << (function ? o3tl::toU(function) : u"???") << ") at "
361 << (file ? o3tl::toU(file) : u"???") << ":" << line);
366 #endif
368 void SbRtl_CurDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
370 (void)pBasic;
371 (void)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.
378 #if defined(_WIN32)
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 );
386 return;
388 auto c = rtl::toAsciiUpperCase(aDrive[0]);
389 if ( !rtl::isAsciiUpperCase( c ) )
391 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
392 return;
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"
399 // handler:
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);
403 if ( ok )
405 rPar.Get(0)->PutString( o3tl::toU(pBuffer) );
407 else
409 StarBASIC::Error( ERRCODE_BASIC_NO_DEVICE );
412 #else
414 const int PATH_INCR = 250;
416 int nSize = PATH_INCR;
417 std::unique_ptr<char[]> pMem;
418 while( true )
420 pMem.reset(new char[nSize]);
421 if( !pMem )
423 StarBASIC::Error( ERRCODE_BASIC_NO_MEMORY );
424 return;
426 if( getcwd( pMem.get(), nSize-1 ) != nullptr )
428 rPar.Get(0)->PutString( OUString::createFromAscii(pMem.get()) );
429 return;
431 if( errno != ERANGE )
433 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
434 return;
436 nSize += PATH_INCR;
439 #endif
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() );
453 else
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();
473 if( xSFI.is() )
477 OUString aSourceFullPath = getFullPath( aSource );
478 if( !xSFI->exists( aSourceFullPath ) )
480 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
481 return;
484 OUString aDestFullPath = getFullPath( aDest );
485 if( xSFI->exists( aDestFullPath ) )
487 StarBASIC::Error( ERRCODE_BASIC_FILE_EXISTS );
489 else
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();
518 if( hasUno() )
520 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
521 if( xSFI.is() )
525 xSFI->copy( getFullPath( aSource ), getFullPath( aDest ) );
527 catch(const Exception & )
529 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
533 else
535 FileBase::RC nRet = File::copy( getFullPath( aSource ), getFullPath( aDest ) );
536 if( nRet != FileBase::E_None )
538 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
542 else
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();
553 if( hasUno() )
555 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
556 if( xSFI.is() )
558 OUString aFullPath = getFullPath( aFileSpec );
559 if( !xSFI->exists( aFullPath ) || xSFI->isFolder( aFullPath ) )
561 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
562 return;
566 xSFI->kill( aFullPath );
568 catch(const Exception & )
570 StarBASIC::Error( ERRCODE_IO_GENERAL );
574 else
576 File::remove( getFullPath( aFileSpec ) );
579 else
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 ) ;
614 if( hasUno() )
616 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
617 if( xSFI.is() )
621 xSFI->createFolder( getFullPath( aPath ) );
623 catch(const Exception & )
625 StarBASIC::Error( ERRCODE_IO_GENERAL );
629 else
631 Directory::create( getFullPath( aPath ) );
634 else
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 )
645 DirectoryItem aItem;
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 );
657 return;
660 Directory aDir( aDirPath );
661 nRet = aDir.open();
662 if( nRet != FileBase::E_None )
664 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
665 return;
668 for( ;; )
670 DirectoryItem aItem2;
671 nRet = aDir.getNextItem( aItem2 );
672 if( nRet != FileBase::E_None )
674 break;
676 // Handle flags
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");
682 continue;
684 OUString aPath = aFileStatus2.getFileURL();
686 // Directory?
687 FileStatus::Type aType2 = aFileStatus2.getFileType();
688 bool bFolder2 = isFolder( aType2 );
689 if( bFolder2 )
691 implRemoveDirRecursive( aPath );
693 else
695 File::remove( aPath );
698 aDir.close();
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();
710 if( hasUno() )
712 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
713 if( xSFI.is() )
717 if( !xSFI->isFolder( aPath ) )
719 StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
720 return;
722 SbiInstance* pInst = GetSbData()->pInst;
723 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
724 if( bCompatibility )
726 Sequence< OUString > aContent = xSFI->getFolderContents( aPath, true );
727 if( aContent.hasElements() )
729 StarBASIC::Error( ERRCODE_BASIC_ACCESS_ERROR );
730 return;
734 xSFI->kill( getFullPath( aPath ) );
736 catch(const Exception & )
738 StarBASIC::Error( ERRCODE_IO_GENERAL );
742 else
744 implRemoveDirRecursive( getFullPath( aPath ) );
747 else
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 );
763 else
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 );
778 else
780 SbxVariableRef pArg = rPar.Get( 1 );
781 OUString aStr( pArg->GetOUString() );
782 sal_Int32 nLen = 0;
783 if( hasUno() )
785 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
786 if( xSFI.is() )
790 nLen = xSFI->getSize( getFullPath( aStr ) );
792 catch(const Exception & )
794 StarBASIC::Error( ERRCODE_IO_GENERAL );
798 else
800 DirectoryItem aItem;
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 );
817 else
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();
836 else
838 SbxVariableRef pVar = new SbxVariable(SbxVARIANT);
839 *rPar.Get(0) = *pVar;
842 else
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;
853 if ( nArgCount < 2 )
854 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
855 else
857 sal_Int32 nStartPos = 1;
858 sal_Int32 nFirstStringPos = 1;
860 if ( nArgCount >= 3 )
862 nStartPos = rPar.Get(1)->GetLong();
863 if( nStartPos <= 0 )
865 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
866 nStartPos = 1;
868 nFirstStringPos++;
871 SbiInstance* pInst = GetSbData()->pInst;
872 bool bTextMode;
873 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
874 if( bCompatibility )
876 SbiRuntime* pRT = pInst->pRun;
877 bTextMode = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
879 else
881 bTextMode = true;
883 if ( nArgCount == 4 )
885 bTextMode = rPar.Get(4)->GetInteger();
887 sal_Int32 nPos;
888 const OUString& rToken = rPar.Get(nFirstStringPos+1)->GetOUString();
890 // #97545 Always find empty string
891 if( rToken.isEmpty() )
893 nPos = nStartPos;
895 else
897 if( !bTextMode )
899 const OUString& rStr1 = rPar.Get(nFirstStringPos)->GetOUString();
900 nPos = rStr1.indexOf( rToken, nStartPos - 1 ) + 1;
902 else
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;
923 if ( nArgCount < 2 )
925 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
927 else
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 );
939 nStartPos = -1;
943 SbiInstance* pInst = GetSbData()->pInst;
944 bool bTextMode;
945 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
946 if( bCompatibility )
948 SbiRuntime* pRT = pInst->pRun;
949 bTextMode = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
951 else
953 bTextMode = true;
955 if ( nArgCount == 4 )
957 bTextMode = rPar.Get(4)->GetInteger();
959 sal_Int32 nStrLen = aStr1.getLength();
960 if( nStartPos == -1 )
962 nStartPos = nStrLen;
965 sal_Int32 nPos = 0;
966 if( nStartPos <= nStrLen )
968 sal_Int32 nTokenLen = aToken.getLength();
969 if( !nTokenLen )
971 // Always find empty string
972 nPos = nStartPos;
974 else if( nStrLen > 0 )
976 if( !bTextMode )
978 nPos = aStr1.lastIndexOf( aToken, nStartPos ) + 1;
980 else
982 aStr1 = aStr1.toAsciiUpperCase();
983 aToken = aToken.toAsciiUpperCase();
985 nPos = aStr1.lastIndexOf( aToken, nStartPos ) + 1;
989 rPar.Get(0)->PutLong( nPos );
995 Int( 2.8 ) = 2.0
996 Int( -2.8 ) = -3.0
997 Fix( 2.8 ) = 2.0
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 );
1005 else
1007 SbxVariableRef pArg = rPar.Get( 1 );
1008 double aDouble= pArg->GetDouble();
1010 floor( 2.8 ) = 2.0
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 );
1023 else
1025 SbxVariableRef pArg = rPar.Get( 1 );
1026 double aDouble = pArg->GetDouble();
1027 if ( aDouble >= 0.0 )
1028 aDouble = floor( aDouble );
1029 else
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 );
1042 else
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 );
1057 else
1059 OUString aStr( rPar.Get(1)->GetOUString() );
1060 sal_Int32 nResultLen = rPar.Get(2)->GetLong();
1061 if( nResultLen < 0 )
1063 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 );
1081 else
1083 double aArg = rPar.Get(1)->GetDouble();
1084 if ( aArg > 0 )
1086 double d = log( aArg );
1087 checkArithmeticOverflow( d );
1088 rPar.Get( 0 )->PutDouble( d );
1090 else
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 );
1103 else
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 );
1120 else
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 )
1128 bWrite = true;
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 );
1136 else
1138 nStartPos--;
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;
1148 nLen = n;
1150 if ( bWrite )
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 );
1160 return;
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;
1172 else
1174 nReplaceLen = nLen;
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 );
1184 aResultStr.insert(
1185 nStartPos, aReplaceStr.getStr(), std::min(nReplaceLen, nReplaceStrLen));
1187 rPar.Get(1)->PutString( aResultStr.makeStringAndClear() );
1189 else
1191 OUString aResultStr;
1192 if (nStartPos > aArgStr.getLength())
1194 // do nothing
1196 else if(nArgCount == 2)
1198 aResultStr = aArgStr.copy( nStartPos);
1200 else
1202 if (nLen < 0)
1203 nLen = 0;
1204 if(nStartPos + nLen > aArgStr.getLength())
1206 nLen = aArgStr.getLength() - nStartPos;
1208 if (nLen > 0)
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 );
1223 else
1225 char aBuffer[16];
1226 SbxVariableRef pArg = rPar.Get( 1 );
1227 if ( pArg->IsInteger() )
1229 snprintf( aBuffer, sizeof(aBuffer), "%o", pArg->GetInteger() );
1231 else
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 );
1248 else
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();
1261 if( lStartPos < 1)
1263 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1264 lStartPos = 1;
1268 sal_Int32 lCount = -1;
1269 if( nArgCount >=5 )
1271 if( rPar.Get(5)->GetType() != SbxEMPTY )
1273 lCount = rPar.Get(5)->GetLong();
1275 if( lCount < -1)
1277 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1278 lCount = -1;
1282 SbiInstance* pInst = GetSbData()->pInst;
1283 bool bTextMode;
1284 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1285 if( bCompatibility )
1287 SbiRuntime* pRT = pInst->pRun;
1288 bTextMode = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
1290 else
1292 bTextMode = true;
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 );
1309 if( bTextMode )
1311 aSrcStr = aSrcStr.toAsciiUpperCase();
1312 aFindStr = aFindStr.toAsciiUpperCase();
1314 nPos = aSrcStr.indexOf( aFindStr, nPos );
1315 if( nPos >= 0 )
1317 aExpStr = aExpStr.replaceAt( nPos, nFindStrLen, aReplaceStr );
1318 nPos = nPos + nReplaceStrLen;
1319 nCounts++;
1321 else
1323 break;
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 );
1337 else
1339 const OUString& rStr = rPar.Get(1)->GetOUString();
1340 int nResultLen = rPar.Get(2)->GetLong();
1341 if( nResultLen < 0 )
1343 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 );
1367 else
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 );
1380 else
1382 double aDouble = rPar.Get(1)->GetDouble();
1383 sal_Int16 nResult = 0;
1384 if ( aDouble > 0 )
1386 nResult = 1;
1388 else if ( aDouble < 0 )
1390 nResult = -1;
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 );
1402 else
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 );
1416 else
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 );
1430 else
1432 double aDouble = rPar.Get(1)->GetDouble();
1433 if ( aDouble >= 0 )
1435 rPar.Get(0)->PutDouble( sqrt( aDouble ));
1437 else
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 );
1450 else
1452 OUString aStr;
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;
1473 if( bNeg )
1475 aStrNew += "-";
1476 iZeroSearch++;
1478 else
1480 if( pBuf[0] != ' ' )
1482 aStrNew += " ";
1485 sal_Int32 iNext = iZeroSearch + 1;
1486 if( pBuf[iZeroSearch] == '0' && nLen > iNext && pBuf[iNext] == '.' )
1488 iZeroSearch += 1;
1490 aStrNew += aStr.copy(iZeroSearch);
1492 else
1494 aStrNew = " " + aStr;
1497 else
1499 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();
1511 return;
1513 const OUString& rStr1 = rPar.Get(1)->GetOUString();
1514 const OUString& rStr2 = rPar.Get(2)->GetOUString();
1516 SbiInstance* pInst = GetSbData()->pInst;
1517 bool bTextCompare;
1518 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1519 if( bCompatibility )
1521 SbiRuntime* pRT = pInst->pRun;
1522 bTextCompare = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
1524 else
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;
1536 if( bTextCompare )
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 );
1554 else
1556 sal_Int32 aResult;
1557 aResult = rStr1.compareTo( rStr2 );
1558 if ( aResult < 0 )
1560 nRetValue = -1;
1562 else if ( aResult > 0)
1564 nRetValue = 1;
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 );
1576 else
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());
1588 else
1590 const OUString& rStr = rPar.Get(2)->GetOUString();
1591 aFiller = rStr[0];
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 );
1603 else
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 );
1617 else
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 );
1630 else
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)
1642 (void)pBasic;
1643 (void)bWrite;
1645 if ( rPar.Count() < 2 )
1647 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
1649 else
1651 double nResult = 0.0;
1652 char* pEndPtr;
1654 OUString aStr( rPar.Get(1)->GetOUString() );
1656 FilterWhiteSpace( aStr );
1657 if ( aStr.getLength() > 1 && aStr[0] == '&' )
1659 int nRadix = 10;
1660 char aChar = static_cast<char>(aStr[1]);
1661 if ( aChar == 'h' || aChar == 'H' )
1663 nRadix = 16;
1665 else if ( aChar == 'o' || aChar == 'O' )
1667 nRadix = 8;
1669 if ( nRadix != 10 )
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);
1676 else
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. */
1688 #if 0
1689 else if ( nParseEnd != aStr.getLength() )
1690 StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
1691 #endif
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() );
1708 return nRet;
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() );
1718 return nRet;
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 );
1730 return aUnoDate;
1733 void SbxDateFromUNODate( SbxValue *pVal, const css::util::Date& aUnoDate)
1735 double dDate;
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 );
1748 return;
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 );
1760 return;
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);
1767 else
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;
1781 return aUnoTime;
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 );
1795 return;
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 );
1807 return;
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);
1814 else
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;
1831 return aUnoDT;
1834 void SbxDateFromUNODateTime( SbxValue *pVal, const css::util::DateTime& aUnoDT)
1836 double dDate(0.0);
1837 if( implDateTimeSerial( aUnoDT.Year, aUnoDT.Month, aUnoDT.Day,
1838 aUnoDT.Hours, aUnoDT.Minutes, aUnoDT.Seconds,
1839 dDate ) )
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 );
1851 return;
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 );
1863 return;
1866 Any aAny (sbxToUnoValue(rPar.Get(1), cppu::UnoType<css::util::DateTime>::get()));
1867 css::util::DateTime aUnoDT;
1868 if(aAny >>= aUnoDT)
1869 SbxDateFromUNODateTime(rPar.Get(0), aUnoDT);
1870 else
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
1882 char Buffer[11];
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 );
1891 else
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();
1906 if (aStr.isEmpty())
1907 break;
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;
1914 if (aStr[0] == '-')
1916 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)
1923 break;
1925 // Now valid
1926 // YYYYMMDD YYYYYMMDD YYMMDD
1927 // YYYY-MM-DD YYYYY-MM-DD
1928 if (nLen != 6 && (nLen < 8 || 11 < nLen))
1929 break;
1931 bool bUseTwoDigitYear = false;
1932 OUString aYearStr, aMonthStr, aDayStr;
1933 if (nLen == 6 || nLen == 8 || nLen == 9)
1935 // ((Y)YY)YYMMDD
1936 if (!comphelper::string::isdigitAsciiString(aStr))
1937 break;
1939 const sal_Int32 nMonthPos = (nLen == 8 ? 4 : (nLen == 6 ? 2 : 5));
1940 if (nMonthPos == 2)
1941 bUseTwoDigitYear = true;
1942 aYearStr = aStr.copy( 0, nMonthPos );
1943 aMonthStr = aStr.copy( nMonthPos, 2 );
1944 aDayStr = aStr.copy( nMonthPos + 2, 2 );
1946 else
1948 // (Y)YYYY-MM-DD
1949 const sal_Int32 nMonthSep = (nLen == 11 ? 5 : 4);
1950 if (aStr.indexOf('-') != nMonthSep)
1951 break;
1952 if (aStr.indexOf('-', nMonthSep + 1) != nMonthSep + 3)
1953 break;
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))
1961 break;
1964 double dDate;
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 ))
1968 break;
1970 rPar.Get(0)->PutDate( dDate );
1972 return;
1974 while (false);
1976 SbxBase::SetError( ERRCODE_BASIC_BAD_PARAMETER );
1978 else
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 );
1989 return;
1991 sal_Int16 nYear = rPar.Get(1)->GetInteger();
1992 sal_Int16 nMonth = rPar.Get(2)->GetInteger();
1993 sal_Int16 nDay = rPar.Get(3)->GetInteger();
1995 double dDate;
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 );
2007 return;
2009 sal_Int16 nHour = rPar.Get(1)->GetInteger();
2010 if ( nHour == 24 )
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 );
2021 return;
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 );
2033 else
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();
2041 else
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);
2049 double fResult;
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 )
2069 // cut time
2070 if ( fResult > 0.0 )
2072 fResult = floor( fResult );
2074 else
2076 fResult = ceil( fResult );
2079 rPar.Get(0)->PutDate( fResult );
2081 else
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 );
2094 else
2096 std::shared_ptr<SvNumberFormatter> pFormatter;
2097 if( GetSbData()->pInst )
2098 pFormatter = GetSbData()->pInst->GetNumberFormatter();
2099 else
2101 sal_uInt32 n;
2102 pFormatter = SbiInstance::PrepareNumberFormatter( n, n, n );
2105 sal_uInt32 nIndex = 0;
2106 double fResult;
2107 bool bSuccess = pFormatter->IsNumberFormat( rPar.Get(1)->GetOUString(),
2108 nIndex, fResult );
2109 SvNumFormatType nType = pFormatter->GetType(nIndex);
2110 if(bSuccess && (nType==SvNumFormatType::TIME||nType==SvNumFormatType::DATETIME))
2112 if ( nType == SvNumFormatType::DATETIME )
2114 // cut days
2115 fResult = fmod( fResult, 1 );
2117 rPar.Get(0)->PutDate( fResult );
2119 else
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 );
2132 else
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 );
2148 else
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 );
2158 nFrac *= 86400.0;
2159 sal_Int32 nSeconds = static_cast<sal_Int32>(nFrac + 0.5);
2160 sal_Int16 nHour = static_cast<sal_Int16>(nSeconds / 3600);
2161 return nHour;
2164 void SbRtl_Hour(StarBASIC *, SbxArray & rPar, bool)
2166 if ( rPar.Count() < 2 )
2168 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2170 else
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 );
2184 else
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 );
2198 else
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 );
2208 nFrac *= 86400.0;
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);
2216 return nRet;
2219 void SbRtl_Second(StarBASIC *, SbxArray & rPar, bool)
2221 if ( rPar.Count() < 2 )
2223 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2225 else
2227 double nArg = rPar.Get(1)->GetDate();
2228 sal_Int16 nSecond = implGetSecond( nArg );
2229 rPar.Get(0)->PutInteger( nSecond );
2233 double Now_Impl()
2235 DateTime aDateTime( DateTime::SYSTEM );
2236 double aSerial = static_cast<double>(GetDayDiff( aDateTime ));
2237 long nSeconds = aDateTime.GetHour();
2238 nSeconds *= 3600;
2239 nSeconds += aDateTime.GetMin() * 60;
2240 nSeconds += aDateTime.GetSec();
2241 double nDays = static_cast<double>(nSeconds) / (24.0*3600.0);
2242 aSerial += nDays;
2243 return aSerial;
2246 // Date Now()
2248 void SbRtl_Now(StarBASIC *, SbxArray & rPar, bool)
2250 rPar.Get(0)->PutDate( Now_Impl() );
2253 // Date Time()
2255 void SbRtl_Time(StarBASIC *, SbxArray & rPar, bool bWrite)
2257 if ( !bWrite )
2259 tools::Time aTime( tools::Time::SYSTEM );
2260 SbxVariable* pMeth = rPar.Get( 0 );
2261 OUString aRes;
2262 if( pMeth->IsFixed() )
2264 // Time$: hh:mm:ss
2265 char buf[ 20 ];
2266 snprintf( buf, sizeof(buf), "%02d:%02d:%02d",
2267 aTime.GetHour(), aTime.GetMin(), aTime.GetSec() );
2268 aRes = OUString::createFromAscii( buf );
2270 else
2272 // Time: system dependent
2273 long nSeconds=aTime.GetHour();
2274 nSeconds *= 3600;
2275 nSeconds += aTime.GetMin() * 60;
2276 nSeconds += aTime.GetSec();
2277 double nDays = static_cast<double>(nSeconds) * ( 1.0 / (24.0*3600.0) );
2278 Color* pCol;
2280 std::shared_ptr<SvNumberFormatter> pFormatter;
2281 sal_uInt32 nIndex;
2282 if( GetSbData()->pInst )
2284 pFormatter = GetSbData()->pInst->GetNumberFormatter();
2285 nIndex = GetSbData()->pInst->GetStdTimeIdx();
2287 else
2289 sal_uInt32 n; // Dummy
2290 pFormatter = SbiInstance::PrepareNumberFormatter( n, nIndex, n );
2293 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2295 pMeth->PutString( aRes );
2297 else
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();
2307 nSeconds *= 3600;
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)
2316 if ( !bWrite )
2318 Date aToday( Date::SYSTEM );
2319 double nDays = static_cast<double>(GetDayDiff( aToday ));
2320 SbxVariable* pMeth = rPar.Get( 0 );
2321 if( pMeth->IsString() )
2323 OUString aRes;
2324 Color* pCol;
2326 std::shared_ptr<SvNumberFormatter> pFormatter;
2327 sal_uInt32 nIndex;
2328 if( GetSbData()->pInst )
2330 pFormatter = GetSbData()->pInst->GetNumberFormatter();
2331 nIndex = GetSbData()->pInst->GetStdDateIdx();
2333 else
2335 sal_uInt32 n;
2336 pFormatter = SbiInstance::PrepareNumberFormatter( nIndex, n, n );
2339 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2340 pMeth->PutString( aRes );
2342 else
2344 pMeth->PutDate( nDays );
2347 else
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 );
2359 else
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 );
2371 else
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 );
2391 else
2393 // #46134 only string is converted, all other types result in sal_False
2394 SbxVariableRef xArg = rPar.Get( 1 );
2395 SbxDataType eType = xArg->GetType();
2396 bool bDate = false;
2398 if( eType == SbxDATE )
2400 bDate = true;
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 );
2425 else
2427 SbxVariable* pVar = nullptr;
2428 if( SbiRuntime::isVBAEnabled() )
2430 pVar = getDefaultProp( rPar.Get(1) );
2432 if ( pVar )
2434 pVar->Broadcast( SfxHintId::BasicDataWanted );
2435 rPar.Get( 0 )->PutBool( pVar->IsEmpty() );
2437 else
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 );
2450 else
2452 SbxVariable* pVar =rPar.Get( 1 );
2453 SbUnoObject* pObj = dynamic_cast<SbUnoObject*>( pVar );
2454 if ( !pObj )
2456 if ( SbxBase* pBaseObj = (pVar->IsObject() ? pVar->GetObject() : nullptr) )
2458 pObj = dynamic_cast<SbUnoObject*>( pBaseObj );
2461 uno::Reference< script::XErrorQuery > xError;
2462 if ( pObj )
2464 xError.set( pObj->getUnoAny(), uno::UNO_QUERY );
2466 if ( xError.is() )
2468 rPar.Get( 0 )->PutBool( xError->hasError() );
2470 else
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 );
2483 else
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();
2492 if( !pObj )
2494 bNull = true;
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 );
2507 else
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 );
2520 else
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 );
2540 if( nLastWild < 0 )
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 );
2552 if( bHasWildcards )
2554 // Wildcards in path?
2555 if( nLastDelim >= 0 && nLastDelim > nLastWild )
2557 return aFileParam;
2560 else
2562 OUString aPathStr = getFullPath( aFileParam );
2563 if( nLastDelim != aFileParam.getLength() - 1 )
2565 rRTLData.sFullNameToBeChecked = aPathStr;
2567 return aPathStr;
2570 OUString aPureFileName;
2571 if( nLastDelim < 0 )
2573 aPureFileName = aFileParam;
2574 aFileParam.clear();
2576 else
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);
2591 return aPathStr;
2594 static bool implCheckWildcard(const OUString& rName, SbiRTLData const& rRTLData)
2596 bool bMatch = true;
2598 if (rRTLData.pWildCard)
2600 bMatch = rRTLData.pWildCard->Matches(rName);
2602 return bMatch;
2606 static bool isRootDir( const OUString& aDirURLStr )
2608 INetURLObject aDirURLObj( aDirURLStr );
2609 bool bRoot = false;
2611 // Check if it's a root directory
2612 sal_Int32 nCount = aDirURLObj.getSegmentCount();
2614 // No segment means Unix root directory "file:///"
2615 if( nCount == 0 )
2617 bRoot = true;
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] == ':' )
2628 bRoot = true;
2631 // More than one segments can never be root
2632 // so bRoot remains false
2634 return bRoot;
2637 void SbRtl_Dir(StarBASIC *, SbxArray & rPar, bool)
2639 OUString aPath;
2641 sal_uInt16 nParCount = rPar.Count();
2642 if( nParCount > 3 )
2644 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
2646 else
2648 SbiRTLData& rRTLData = GetSbData()->pInst->GetRTLData();
2650 if( hasUno() )
2652 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
2653 if( xSFI.is() )
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;
2667 if( bExists )
2669 INetURLObject aFileURL( aFileURLStr );
2670 aNameOnlyStr = aFileURL.getName( INetURLObject::LAST_SEGMENT,
2671 true, INetURLObject::DecodeMechanism::WithCharset );
2673 rPar.Get(0)->PutString( aNameOnlyStr );
2674 return;
2679 OUString aDirURLStr;
2680 bool bFolder = xSFI->isFolder( aFileURLStr );
2682 if( bFolder )
2684 aDirURLStr = aFileURLStr;
2686 else
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());
2697 else
2699 rRTLData.nDirFlags = SbAttributes::NONE;
2701 // Read directory
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 ".."
2715 if( !bRoot )
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() );
2733 for( ;; )
2735 if (rRTLData.nCurDirPos < 0)
2737 if (rRTLData.nCurDirPos == -2)
2739 aPath = ".";
2741 else if (rRTLData.nCurDirPos == -1)
2743 aPath = "..";
2745 rRTLData.nCurDirPos++;
2747 else if (rRTLData.nCurDirPos >= rRTLData.aDirSeq.getLength())
2749 rRTLData.aDirSeq.realloc(0);
2750 aPath.clear();
2751 break;
2753 else
2755 OUString aFile
2756 = rRTLData.aDirSeq.getConstArray()[rRTLData.nCurDirPos++];
2758 if( bCompatibility )
2760 if( !bFolderFlag )
2762 bool bFolder = xSFI->isFolder( aFile );
2763 if( bFolder )
2765 continue;
2769 else
2771 // Only directories
2772 if( bFolderFlag )
2774 bool bFolder = xSFI->isFolder( aFile );
2775 if( !bFolder )
2777 continue;
2782 INetURLObject aURL( aFile );
2783 aPath = aURL.getName( INetURLObject::LAST_SEGMENT, true,
2784 INetURLObject::DecodeMechanism::WithCharset );
2787 bool bMatch = implCheckWildcard(aPath, rRTLData);
2788 if( !bMatch )
2790 continue;
2792 break;
2795 rPar.Get(0)->PutString( aPath );
2798 else
2800 // TODO: OSL
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());
2813 else
2815 rRTLData.nDirFlags = SbAttributes::NONE;
2818 // Read directory
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() );
2826 return;
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 ".."
2839 if( !bRoot )
2841 rRTLData.nCurDirPos = -2;
2847 if (rRTLData.pDir)
2849 bool bFolderFlag = bool(rRTLData.nDirFlags & SbAttributes::DIRECTORY);
2850 for( ;; )
2852 if (rRTLData.nCurDirPos < 0)
2854 if (rRTLData.nCurDirPos == -2)
2856 aPath = ".";
2858 else if (rRTLData.nCurDirPos == -1)
2860 aPath = "..";
2862 rRTLData.nCurDirPos++;
2864 else
2866 DirectoryItem aItem;
2867 FileBase::RC nRet = rRTLData.pDir->getNextItem(aItem);
2868 if( nRet != FileBase::E_None )
2870 rRTLData.pDir.reset();
2871 aPath.clear();
2872 break;
2875 // Handle flags
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");
2881 continue;
2884 // Only directories?
2885 if( bFolderFlag )
2887 FileStatus::Type aType = aFileStatus.getFileType();
2888 bool bFolder = isFolder( aType );
2889 if( !bFolder )
2891 continue;
2895 aPath = aFileStatus.getFileName();
2898 bool bMatch = implCheckWildcard(aPath, rRTLData);
2899 if( !bMatch )
2901 continue;
2903 break;
2906 rPar.Get(0)->PutString( aPath );
2912 void SbRtl_GetAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
2914 (void)pBasic;
2915 (void)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.
2923 #if defined(_WIN32)
2924 if( SbiRuntime::isVBAEnabled() )
2926 OUString aPathURL = getFullPath( rPar.Get(1)->GetOUString() );
2927 OUString aPath;
2928 FileBase::getSystemPathFromFileURL( aPathURL, aPath );
2929 DWORD nRealFlags = GetFileAttributesW (o3tl::toW(aPath.getStr()));
2930 if (nRealFlags != 0xffffffff)
2932 if (nRealFlags == FILE_ATTRIBUTE_NORMAL)
2934 nRealFlags = 0;
2936 nFlags = static_cast<sal_Int16>(nRealFlags);
2938 else
2940 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
2942 rPar.Get(0)->PutInteger( nFlags );
2944 return;
2946 #endif
2948 if( hasUno() )
2950 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
2951 if( xSFI.is() )
2955 OUString aPath = getFullPath( rPar.Get(1)->GetOUString() );
2956 bool bExists = false;
2957 try { bExists = xSFI->exists( aPath ); }
2958 catch(const Exception & ) {}
2959 if( !bExists )
2961 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
2962 return;
2965 bool bReadOnly = xSFI->isReadOnly( aPath );
2966 bool bHidden = xSFI->isHidden( aPath );
2967 bool bDirectory = xSFI->isFolder( aPath );
2968 if( bReadOnly )
2970 nFlags |= sal_uInt16(SbAttributes::READONLY);
2972 if( bHidden )
2974 nFlags |= sal_uInt16(SbAttributes::HIDDEN);
2976 if( bDirectory )
2978 nFlags |= sal_uInt16(SbAttributes::DIRECTORY);
2981 catch(const Exception & )
2983 StarBASIC::Error( ERRCODE_IO_GENERAL );
2987 else
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 );
2998 if( bReadOnly )
3000 nFlags |= sal_uInt16(SbAttributes::READONLY);
3002 if( bDirectory )
3004 nFlags |= sal_uInt16(SbAttributes::DIRECTORY);
3007 rPar.Get(0)->PutInteger( nFlags );
3009 else
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 );
3022 else
3024 OUString aPath = rPar.Get(1)->GetOUString();
3025 tools::Time aTime( tools::Time::EMPTY );
3026 Date aDate( Date::EMPTY );
3027 if( hasUno() )
3029 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
3030 if( xSFI.is() )
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 );
3044 else
3046 bool bSuccess = false;
3049 DirectoryItem aItem;
3050 if (DirectoryItem::get( getFullPath( aPath ), aItem ) != FileBase::E_None)
3051 break;
3053 FileStatus aFileStatus( osl_FileStatus_Mask_ModifyTime );
3054 if (aItem.getFileStatus( aFileStatus ) != FileBase::E_None)
3055 break;
3057 TimeValue aTimeVal = aFileStatus.getModifyTime();
3058 oslDateTime aDT;
3059 if (!osl_getDateTimeFromTimeValue( &aTimeVal, &aDT ))
3060 // Strictly spoken this is not an i/o error but some other failure.
3061 break;
3063 aTime = tools::Time( aDT.Hours, aDT.Minutes, aDT.Seconds, aDT.NanoSeconds );
3064 aDate = Date( aDT.Day, aDT.Month, aDT.Year );
3065 bSuccess = true;
3067 while(false);
3069 if (!bSuccess)
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.
3078 OUString aRes;
3079 if (aDate.IsEmpty())
3081 aRes = "0000-00-00 00:00:00";
3083 else
3085 double fSerial = static_cast<double>(GetDayDiff( aDate ));
3086 long nSeconds = aTime.GetHour();
3087 nSeconds *= 3600;
3088 nSeconds += aTime.GetMin() * 60;
3089 nSeconds += aTime.GetSec();
3090 double nDays = static_cast<double>(nSeconds) / (24.0*3600.0);
3091 fSerial += nDays;
3093 Color* pCol;
3095 std::shared_ptr<SvNumberFormatter> pFormatter;
3096 sal_uInt32 nIndex;
3097 if( GetSbData()->pInst )
3099 pFormatter = GetSbData()->pInst->GetNumberFormatter();
3100 nIndex = GetSbData()->pInst->GetStdDateTimeIdx();
3102 else
3104 sal_uInt32 n;
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 );
3122 else
3124 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3125 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3126 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3127 if ( !pSbStrm )
3129 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3130 return;
3132 bool beof;
3133 SvStream* pSvStrm = pSbStrm->GetStrm();
3134 if ( pSbStrm->IsText() )
3136 char cBla;
3137 (*pSvStrm).ReadChar( cBla ); // can we read another character?
3138 beof = pSvStrm->eof();
3139 if ( !beof )
3141 pSvStrm->SeekRel( -1 );
3144 else
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 );
3163 else
3165 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3166 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3167 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3168 if ( !pSbStrm )
3170 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3171 return;
3173 sal_Int16 nRet;
3174 if ( rPar.Get(2)->GetInteger() == 1 )
3176 nRet = static_cast<sal_Int16>(pSbStrm->GetMode());
3178 else
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 );
3192 else
3194 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3195 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3196 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3197 if ( !pSbStrm )
3199 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3200 return;
3202 SvStream* pSvStrm = pSbStrm->GetStrm();
3203 std::size_t nPos;
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;
3222 else
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 );
3237 else
3239 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3240 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3241 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3242 if ( !pSbStrm )
3244 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3245 return;
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 );
3261 return;
3263 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3264 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3265 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3266 if ( !pSbStrm )
3268 StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
3269 return;
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();
3286 if ( nPos < 1 )
3288 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3289 return;
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 );
3309 else
3311 OUString aResult;
3312 if( nArgCount == 2 )
3314 rPar.Get(1)->Format( aResult );
3316 else
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);
3332 return;
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);
3344 return;
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;
3359 break;
3360 case ooo::vba::VbTriState::vbTrue:
3361 bIncludeLeadingDigit = true;
3362 break;
3363 case ooo::vba::VbTriState::vbUseDefault:
3364 // do nothing;
3365 break;
3366 default:
3367 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3368 return;
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:
3379 // do nothing
3380 break;
3381 case ooo::vba::VbTriState::vbTrue:
3382 bUseParensForNegativeNumbers = true;
3383 break;
3384 default:
3385 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3386 return;
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:
3397 // do nothing
3398 break;
3399 case ooo::vba::VbTriState::vbTrue:
3400 bGroupDigits = true;
3401 break;
3402 default:
3403 StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
3404 return;
3408 double fVal = rPar.Get(1)->GetDouble();
3409 const bool bNegative = fVal < 0;
3410 if (bNegative)
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);
3426 if (nSepPos == -1)
3427 nActualDigits = 0;
3428 else
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');
3437 aResult += sBuf;
3441 if (bNegative)
3443 if (bUseParensForNegativeNumbers)
3444 aResult = "(" + aResult + ")";
3445 else
3446 aResult = "-" + aResult;
3449 rPar.Get(0)->PutString(aResult);
3452 namespace {
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 );
3504 else
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):
3515 // 2 == Minimized
3516 // 3 == Maximized
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 );
3530 else
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();
3539 if (!tmp.isEmpty())
3541 aCmdLine += " " + tmp;
3544 else if( aCmdLine.isEmpty() )
3546 // avoid special treatment (empty list)
3547 aCmdLine += " ";
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;
3554 OUString aToken;
3555 sal_Int32 i = 0;
3556 sal_Unicode c;
3557 while( i < nLen )
3559 for ( ;; ++i )
3561 c = aCmdLine[ i ];
3562 if ( c != ' ' && c != '\t' )
3564 break;
3568 if( c == '\"' || c == '\'' )
3570 sal_Int32 iFoundPos = aCmdLine.indexOf( c, i + 1 );
3572 if( iFoundPos < 0 )
3574 aToken = aCmdLine.copy( i);
3575 i = nLen;
3577 else
3579 aToken = aCmdLine.copy( i + 1, (iFoundPos - i - 1) );
3580 i = iFoundPos + 1;
3583 else
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;
3589 if( iFoundPos < 0 )
3591 aToken = aCmdLine.copy( i );
3592 i = nLen;
3594 else
3596 aToken = aCmdLine.copy( i, (iFoundPos - i) );
3597 i = iFoundPos;
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();
3610 switch( nWinStyle )
3612 case 2:
3613 nOptions |= osl_Process_MINIMIZED;
3614 break;
3615 case 3:
3616 nOptions |= osl_Process_MAXIMIZED;
3617 break;
3618 case 10:
3619 nOptions |= osl_Process_FULLSCREEN;
3620 break;
3623 bool bSync = false;
3624 if( nArgCount >= 5 )
3626 bSync = rPar.Get(4)->GetBool();
3628 if( bSync )
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 );
3638 ++iter;
3640 sal_uInt16 nParamCount = sal::static_int_cast< sal_uInt16 >(aTokenVector.size() - 1 );
3641 std::unique_ptr<rtl_uString*[]> pParamList;
3642 if( nParamCount )
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);
3653 oslProcess pApp;
3654 bool bSucc = osl_executeProcess(
3655 aOUStrProgURL.pData,
3656 pParamList.get(),
3657 nParamCount,
3658 nOptions,
3659 nullptr,
3660 nullptr,
3661 nullptr, 0,
3662 &pApp ) == osl_Process_E_None;
3664 // 53521 only free process handle on success
3665 if (bSucc)
3667 osl_freeProcessHandle( pApp );
3670 for(int j = 0; j < nParamCount; ++j)
3672 rtl_uString_release(pParamList[j]);
3675 if( !bSucc )
3677 StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
3679 else
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 );
3692 else
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
3705 "Null", // SbxNULL
3706 "Integer", // SbxINTEGER
3707 "Long", // SbxLONG
3708 "Single", // SbxSINGLE
3709 "Double", // SbxDOUBLE
3710 "Currency", // SbxCURRENCY
3711 "Date", // SbxDATE
3712 "String", // SbxSTRING
3713 "Object", // SbxOBJECT
3714 "Error", // SbxERROR
3715 "Boolean", // SbxBOOL
3716 "Variant", // SbxVARIANT
3717 "DataObject", // SbxDATAOBJECT
3718 "Unknown Type",
3719 "Unknown Type",
3720 "Char", // SbxCHAR
3721 "Byte", // SbxBYTE
3722 "UShort", // SbxUSHORT
3723 "ULong", // SbxULONG
3724 "Long64", // SbxLONG64
3725 "ULong64", // SbxULONG64
3726 "Int", // SbxINT
3727 "UInt", // SbxUINT
3728 "Void", // SbxVOID
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" );
3756 if ( pVar )
3758 SbxBase* pBaseObj = pVar->GetObject();
3759 if( !pBaseObj )
3761 sRet = "Nothing";
3763 else
3765 SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pVar );
3766 if ( !pUnoObj )
3768 pUnoObj = dynamic_cast<SbUnoObject*>( pBaseObj );
3770 if ( pUnoObj )
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
3775 // other way
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 ];
3787 else
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 );
3793 if ( xInv.is() )
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 );
3813 return sRet;
3816 void SbRtl_TypeName(StarBASIC *, SbxArray & rPar, bool)
3818 if ( rPar.Count() != 2 )
3820 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3822 else
3824 SbxDataType eType = rPar.Get(1)->GetType();
3825 bool bIsArray = ( ( eType & SbxARRAY ) != 0 );
3827 OUString aRetStr;
3828 if ( SbiRuntime::isVBAEnabled() && eType == SbxOBJECT )
3830 aRetStr = getObjectTypeName( rPar.Get(1) );
3832 else
3834 aRetStr = getBasicTypeName( eType );
3836 if( bIsArray )
3838 aRetStr += "()";
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 );
3850 else
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());
3860 if ( nArgs != 3 )
3862 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3863 return;
3865 const OUString& rApp = rPar.Get(1)->GetOUString();
3866 const OUString& rTopic = rPar.Get(2)->GetOUString();
3868 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3869 size_t nChannel;
3870 ErrCode nDdeErr = pDDE->Initiate( rApp, rTopic, nChannel );
3871 if( nDdeErr )
3873 StarBASIC::Error( nDdeErr );
3875 else
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());
3885 if ( nArgs != 2 )
3887 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3888 return;
3890 size_t nChannel = rPar.Get(1)->GetInteger();
3891 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3892 ErrCode nDdeErr = pDDE->Terminate( nChannel );
3893 if( nDdeErr )
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());
3903 if ( nArgs != 1 )
3905 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3906 return;
3909 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3910 ErrCode nDdeErr = pDDE->TerminateAll();
3911 if( nDdeErr )
3913 StarBASIC::Error( nDdeErr );
3917 void SbRtl_DDERequest(StarBASIC *, SbxArray & rPar, bool)
3919 int nArgs = static_cast<int>(rPar.Count());
3920 if ( nArgs != 3 )
3922 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3923 return;
3925 size_t nChannel = rPar.Get(1)->GetInteger();
3926 const OUString& rItem = rPar.Get(2)->GetOUString();
3927 SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
3928 OUString aResult;
3929 ErrCode nDdeErr = pDDE->Request( nChannel, rItem, aResult );
3930 if( nDdeErr )
3932 StarBASIC::Error( nDdeErr );
3934 else
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());
3944 if ( nArgs != 3 )
3946 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3947 return;
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 );
3953 if( nDdeErr )
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());
3963 if ( nArgs != 4 )
3965 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3966 return;
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 );
3973 if( nDdeErr )
3975 StarBASIC::Error( nDdeErr );
3980 void SbRtl_FreeFile(StarBASIC *, SbxArray & rPar, bool)
3982 if ( rPar.Count() != 1 )
3984 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
3985 return;
3987 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
3988 short nChannel = 1;
3989 while( nChannel < CHANNELS )
3991 SbiStream* pStrm = pIO->GetStream( nChannel );
3992 if( !pStrm )
3994 rPar.Get(0)->PutInteger( nChannel );
3995 return;
3997 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 );
4008 return;
4010 SbxBase* pParObj = rPar.Get(1)->GetObject();
4011 SbxDimArray* pArr = dynamic_cast<SbxDimArray*>( pParObj );
4012 if( pArr )
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 );
4018 else
4019 rPar.Get(0)->PutLong( nLower );
4021 else
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 );
4031 return;
4034 SbxBase* pParObj = rPar.Get(1)->GetObject();
4035 SbxDimArray* pArr = dynamic_cast<SbxDimArray*>( pParObj );
4036 if( pArr )
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 );
4042 else
4043 rPar.Get(0)->PutLong( nUpper );
4045 else
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 );
4054 return;
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;
4060 sal_Int32 nRGB;
4062 SbiInstance* pInst = GetSbData()->pInst;
4063 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
4064 if( bCompatibility )
4066 nRGB = (nBlue << 16) | (nGreen << 8) | nRed;
4068 else
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[] =
4079 0x000000,
4080 0x800000,
4081 0x008000,
4082 0x808000,
4083 0x000080,
4084 0x800080,
4085 0x008080,
4086 0xC0C0C0,
4087 0x808080,
4088 0xFF0000,
4089 0x00FF00,
4090 0xFFFF00,
4091 0x0000FF,
4092 0xFF00FF,
4093 0x00FFFF,
4094 0xFFFFFF,
4097 if ( rPar.Count() != 2 )
4099 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4100 return;
4103 sal_Int16 nCol = rPar.Get(1)->GetInteger();
4104 if( nCol < 0 || nCol > 15 )
4106 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4107 return;
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 );
4120 return;
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();
4129 if( nOldLen == 0 )
4131 // null string,return
4132 rPar.Get(0)->PutString(aOldStr);
4133 return;
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 );
4185 if( i%2 )
4187 pSrc++;
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 );
4196 return;
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() );
4206 if(nArraySize)
4208 if( bIncIndex )
4210 pArray->AddDim( 1, nArraySize );
4212 else
4214 pArray->AddDim( 0, nArraySize-1 );
4217 else
4219 pArray->unoAddDim( 0, -1 );
4222 for( sal_Int32 i=0; i< nArraySize; i++)
4224 SbxVariable* pNew = new SbxVariable( SbxBYTE );
4225 pNew->PutByte(*pChar);
4226 pChar++;
4227 pNew->SetFlag( SbxFlagBits::Write );
4228 short aIdx[1];
4229 aIdx[0] = i;
4230 if( bIncIndex )
4232 ++aIdx[0];
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 );
4243 return;
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 );
4254 return;
4256 Sound::Beep();
4259 void SbRtl_Load(StarBASIC *, SbxArray & rPar, bool)
4261 if( rPar.Count() != 2 )
4263 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4264 return;
4268 SbxBase* pObj = rPar.Get(1)->GetObject();
4269 if ( pObj )
4271 if (SbUserFormModule* pModule = dynamic_cast<SbUserFormModule*>(pObj))
4273 pModule->Load();
4275 else if (SbxObject* pSbxObj = dynamic_cast<SbxObject*>(pObj))
4277 SbxVariable* pVar = pSbxObj->Find("Load", SbxClassType::Method);
4278 if( pVar )
4280 pVar->GetInteger();
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 );
4292 return;
4296 SbxBase* pObj = rPar.Get(1)->GetObject();
4297 if ( pObj )
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);
4306 if( pVar )
4308 pVar->GetInteger();
4314 void SbRtl_LoadPicture(StarBASIC *, SbxArray & rPar, bool)
4316 if( rPar.Count() != 2 )
4318 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4319 return;
4322 OUString aFileURL = getFullPath( rPar.Get(1)->GetOUString() );
4323 std::unique_ptr<SvStream> pStream(utl::UcbStreamHelper::CreateStream( aFileURL, StreamMode::READ ));
4324 if( pStream )
4326 Bitmap aBmp;
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 );
4342 return;
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 );
4360 return;
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
4367 if (nStyle > 5)
4368 nStyle = 0;
4370 enum BasicResponse
4372 Ok = 1,
4373 Cancel = 2,
4374 Abort = 3,
4375 Retry = 4,
4376 Ignore = 5,
4377 Yes = 6,
4378 No = 7
4381 OUString aMsg = rPar.Get(1)->GetOUString();
4382 OUString aTitle;
4383 if( nArgCount >= 4 )
4385 aTitle = rPar.Get(3)->GetOUString();
4387 else
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)
4402 case 16:
4403 eType = VclMessageType::Error;
4404 break;
4405 case 32:
4406 eType = VclMessageType::Question;
4407 break;
4408 case 48:
4409 eType = VclMessageType::Warning;
4410 break;
4411 case 64:
4412 default:
4413 eType = VclMessageType::Info;
4414 break;
4417 std::unique_ptr<weld::MessageDialog> xBox(Application::CreateMessageDialog(pParent,
4418 eType, VclButtonsType::NONE, aMsg));
4420 switch (nStyle)
4422 case 0: // MB_OK
4423 default:
4424 xBox->add_button(GetStandardText(StandardButtonType::OK), BasicResponse::Ok);
4425 break;
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);
4432 else
4433 xBox->set_default_response(BasicResponse::Ok);
4435 break;
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);
4441 if (nType & 256)
4442 xBox->set_default_response(BasicResponse::Retry);
4443 else if (nType & 512)
4444 xBox->set_default_response(BasicResponse::Ignore);
4445 else
4446 xBox->set_default_response(BasicResponse::Cancel);
4448 break;
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);
4456 else
4457 xBox->set_default_response(BasicResponse::Yes);
4459 break;
4460 case 4: // MB_YESNO
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);
4466 else
4467 xBox->set_default_response(BasicResponse::Yes);
4469 break;
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);
4476 else
4477 xBox->set_default_response(BasicResponse::Retry);
4479 break;
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() );
4495 if( hasUno() )
4497 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
4498 if( xSFI.is() )
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 );
4514 else
4516 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4520 void SbRtl_Reset(StarBASIC *, SbxArray &, bool)
4522 SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
4523 if (pIO)
4525 pIO->CloseAll();
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 );
4536 else if( !pBasic )
4538 StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
4540 else
4542 SbxObject* p = pBasic;
4543 while( p->GetParent() )
4545 p = p->GetParent();
4547 SvFileStream aStrm( rPar.Get( 1 )->GetOUString(),
4548 StreamMode::WRITE | StreamMode::TRUNC );
4549 p->Dump( aStrm, rPar.Get( 2 )->GetBool() );
4550 aStrm.Close();
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;
4566 if( hasUno() )
4568 const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
4569 if( xSFI.is() )
4573 bExists = xSFI->exists( aStr );
4575 catch(const Exception & )
4577 StarBASIC::Error( ERRCODE_IO_GENERAL );
4581 else
4583 DirectoryItem aItem;
4584 FileBase::RC nRet = DirectoryItem::get( getFullPath( aStr ), aItem );
4585 bExists = (nRet == FileBase::E_None);
4587 rPar.Get(0)->PutBool( bExists );
4589 else
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 );
4600 return;
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 );
4611 return;
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;
4638 else
4640 sal_Int32 nLowerValue = nNumber;
4641 sal_Int32 nUpperValue = nLowerValue;
4642 if( nInterval > 1 )
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();
4654 if( nLen > nLen1 )
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(":");
4663 if( nLen > nLen2 )
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());
4675 #endif
4677 static long GetDayDiff( const Date& rDate )
4679 Date aRefDate( 1,1,1900 );
4680 long nDiffDays;
4681 if ( aRefDate > rDate )
4683 nDiffDays = aRefDate - rDate;
4684 nDiffDays *= -1;
4686 else
4688 nDiffDays = rDate - aRefDate;
4690 nDiffDays += 2; // adjustment VisualBasic: 1.Jan.1900 == 2
4691 return nDiffDays;
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();
4701 return nRet;
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 );
4719 return false;
4721 else if ( nYear < 30 && SbiRuntime::isVBAEnabled() )
4723 nYear += 2000;
4725 else
4726 #endif
4728 if ( 0 <= nYear && nYear < 100 && (bUseTwoDigitYear
4729 #if HAVE_FEATURE_SCRIPTING
4730 || SbiRuntime::isVBAEnabled()
4731 #endif
4734 nYear += 1900;
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;
4745 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)
4750 if (nDay < 1)
4752 nAddDays = nDay - 1;
4753 nDay = 1;
4755 else if (nDay > 31)
4757 nAddDays = nDay - 31;
4758 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
4769 * documentation.*/
4770 #if HAVE_FEATURE_SCRIPTING
4771 if (eCorr == SbDateCorrection::RollOver && !SbiRuntime::isVBAEnabled())
4772 eCorr = SbDateCorrection::None;
4773 #endif
4775 if (nYear == 0 || (eCorr == SbDateCorrection::None && (nAddMonths || nAddDays || !aCurDate.IsValidDate())))
4777 #if HAVE_FEATURE_SCRIPTING
4778 StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
4779 #endif
4780 return false;
4783 if (eCorr != SbDateCorrection::None)
4785 aCurDate.Normalize();
4786 if (nAddMonths)
4787 aCurDate.AddMonths( nAddMonths);
4788 if (nAddDays)
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);
4798 else
4800 aCurDate.SetMonth(nMonth);
4801 aCurDate.SetDay(1);
4802 aCurDate.AddMonths(1);
4803 aCurDate.AddDays(-1);
4808 long nDiffDays = GetDayDiff( aCurDate );
4809 rdRet = static_cast<double>(nDiffDays);
4810 return true;
4813 double implTimeSerial( sal_Int16 nHours, sal_Int16 nMinutes, sal_Int16 nSeconds )
4815 return
4816 static_cast<double>( nHours * ::tools::Time::secondPerHour +
4817 nMinutes * ::tools::Time::secondPerMinute +
4818 nSeconds)
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,
4825 double& rdRet )
4827 double dDate;
4828 if(!implDateSerial(nYear, nMonth, nDay, false/*bUseTwoDigitYear*/, SbDateCorrection::None, dDate))
4829 return false;
4830 rdRet += dDate + implTimeSerial(nHour, nMinute, nSecond);
4831 return true;
4834 sal_Int16 implGetMinute( double dDate )
4836 double nFrac = dDate - floor( dDate );
4837 nFrac *= 86400.0;
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;
4841 return nMin;
4844 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */