1 /**************************************************************
2 *
3 * Licensed to the Apache Software Foundation (ASF) under one
4 * or more contributor license agreements. See the NOTICE file
5 * distributed with this work for additional information
6 * regarding copyright ownership. The ASF licenses this file
7 * to you under the Apache License, Version 2.0 (the
8 * "License"); you may not use this file except in compliance
9 * with the License. You may obtain a copy of the License at
10 *
11 * http://www.apache.org/licenses/LICENSE-2.0
12 *
13 * Unless required by applicable law or agreed to in writing,
14 * software distributed under the License is distributed on an
15 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16 * KIND, either express or implied. See the License for the
17 * specific language governing permissions and limitations
18 * under the License.
19 *
20 *************************************************************/
21
22 // MARKER(update_precomp.py): autogen include statement, do not remove
23 #include "precompiled_basic.hxx"
24
25 #include <tools/date.hxx>
26 #include <basic/sbxvar.hxx>
27 #include <vos/process.hxx>
28 #include <vcl/svapp.hxx>
29 #include <vcl/settings.hxx>
30 #include <vcl/sound.hxx>
31 #include <tools/wintypes.hxx>
32 #include <vcl/msgbox.hxx>
33 #include <basic/sbx.hxx>
34 #include <svl/zforlist.hxx>
35 #include <rtl/math.hxx>
36 #include <tools/urlobj.hxx>
37 #include <osl/time.h>
38 #include <unotools/charclass.hxx>
39 #include <unotools/ucbstreamhelper.hxx>
40 #include <tools/wldcrd.hxx>
41 #include <i18npool/lang.h>
42 #include <vcl/dibtools.hxx>
43
44 #include "runtime.hxx"
45 #include "sbunoobj.hxx"
46 #ifdef WNT
47 #include <tools/prewin.h>
48 #include "winbase.h"
49 #include <tools/postwin.h>
50 #ifndef _FSYS_HXX //autogen
51 #include <tools/fsys.hxx>
52 #endif
53 #else
54 #include <osl/file.hxx>
55 #endif
56 #include "errobject.hxx"
57
58 #ifdef _USE_UNO
59 #include <comphelper/processfactory.hxx>
60
61 #include <com/sun/star/uno/Sequence.hxx>
62 #include <com/sun/star/util/DateTime.hpp>
63 #include <com/sun/star/lang/XMultiServiceFactory.hpp>
64 #include <com/sun/star/lang/Locale.hpp>
65 #include <com/sun/star/ucb/XSimpleFileAccess3.hpp>
66 #include <com/sun/star/io/XInputStream.hpp>
67 #include <com/sun/star/io/XOutputStream.hpp>
68 #include <com/sun/star/io/XStream.hpp>
69 #include <com/sun/star/io/XSeekable.hpp>
70
71 using namespace comphelper;
72 using namespace osl;
73 using namespace com::sun::star::uno;
74 using namespace com::sun::star::lang;
75 using namespace com::sun::star::ucb;
76 using namespace com::sun::star::io;
77 using namespace com::sun::star::frame;
78
79 #endif /* _USE_UNO */
80
81 //#define _ENABLE_CUR_DIR
82
83 #include "stdobj.hxx"
84 #include <basic/sbstdobj.hxx>
85 #include "rtlproto.hxx"
86 #include "basrid.hxx"
87 #include "image.hxx"
88 #include "sb.hrc"
89 #include "iosys.hxx"
90 #include "ddectrl.hxx"
91 #include <sbintern.hxx>
92 #include <basic/vbahelper.hxx>
93
94 #include <list>
95 #include <math.h>
96 #include <stdio.h>
97 #include <stdlib.h>
98 #include <ctype.h>
99
100 #if defined (WNT) || defined (OS2)
101 #include <direct.h> // _getdcwd get current work directory, _chdrive
102 #endif
103
104 #ifdef UNX
105 #include <errno.h>
106 #include <unistd.h>
107 #endif
108
109 #ifdef WNT
110 #include <io.h>
111 #endif
112
113 #include <basic/sbobjmod.hxx>
114
115 // from source/classes/sbxmod.cxx
116 Reference< XModel > getDocumentModel( StarBASIC* );
117
FilterWhiteSpace(String & rStr)118 static void FilterWhiteSpace( String& rStr )
119 {
120 rStr.EraseAllChars( ' ' );
121 rStr.EraseAllChars( '\t' );
122 rStr.EraseAllChars( '\n' );
123 rStr.EraseAllChars( '\r' );
124 }
125
GetDayDiff(const Date & rDate)126 static long GetDayDiff( const Date& rDate )
127 {
128 Date aRefDate( 1,1,1900 );
129 long nDiffDays;
130 if ( aRefDate > rDate )
131 {
132 nDiffDays = (long)(aRefDate - rDate);
133 nDiffDays *= -1;
134 }
135 else
136 nDiffDays = (long)(rDate - aRefDate);
137 nDiffDays += 2; // Anpassung VisualBasic: 1.Jan.1900 == 2
138 return nDiffDays;
139 }
140
GetCharClass(void)141 static CharClass& GetCharClass( void )
142 {
143 static sal_Bool bNeedsInit = sal_True;
144 static ::com::sun::star::lang::Locale aLocale;
145 if( bNeedsInit )
146 {
147 bNeedsInit = sal_False;
148 aLocale = Application::GetSettings().GetLocale();
149 }
150 static CharClass aCharClass( aLocale );
151 return aCharClass;
152 }
153
isFolder(FileStatus::Type aType)154 static inline sal_Bool isFolder( FileStatus::Type aType )
155 {
156 return ( aType == FileStatus::Directory || aType == FileStatus::Volume );
157 }
158
159
160 //*** UCB file access ***
161
162 // Converts possibly relative paths to absolute paths
163 // according to the setting done by ChDir/ChDrive
getFullPath(const String & aRelPath)164 String getFullPath( const String& aRelPath )
165 {
166 ::rtl::OUString aFileURL;
167
168 // #80204 Try first if it already is a valid URL
169 INetURLObject aURLObj( aRelPath );
170 aFileURL = aURLObj.GetMainURL( INetURLObject::NO_DECODE );
171
172 if( aFileURL.isEmpty() )
173 {
174 File::getFileURLFromSystemPath( aRelPath, aFileURL );
175 }
176
177 return aFileURL;
178 }
179
180 // Sets (virtual) current path for UCB file access
implChDir(const String & aDir)181 void implChDir( const String& aDir )
182 {
183 (void)aDir;
184 // TODO
185 }
186
187 // Sets (virtual) current drive for UCB file access
implChDrive(const String & aDrive)188 void implChDrive( const String& aDrive )
189 {
190 (void)aDrive;
191 // TODO
192 }
193
194 // Returns (virtual) current path for UCB file access
implGetCurDir(void)195 String implGetCurDir( void )
196 {
197 String aRetStr;
198
199 return aRetStr;
200 }
201
202 // TODO: -> SbiGlobals
getFileAccess(void)203 static com::sun::star::uno::Reference< XSimpleFileAccess3 > getFileAccess( void )
204 {
205 static com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI;
206 if( !xSFI.is() )
207 {
208 com::sun::star::uno::Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory();
209 if( xSMgr.is() )
210 {
211 xSFI = com::sun::star::uno::Reference< XSimpleFileAccess3 >( xSMgr->createInstance
212 ( ::rtl::OUString::createFromAscii( "com.sun.star.ucb.SimpleFileAccess" ) ), UNO_QUERY );
213 }
214 }
215 return xSFI;
216 }
217
218
219
220 // Properties und Methoden legen beim Get (bPut = sal_False) den Returnwert
221 // im Element 0 des Argv ab; beim Put (bPut = sal_True) wird der Wert aus
222 // Element 0 gespeichert.
223
224 // CreateObject( class )
225
RTLFUNC(CreateObject)226 RTLFUNC(CreateObject)
227 {
228 (void)bWrite;
229
230 String aClass( rPar.Get( 1 )->GetString() );
231 SbxObjectRef p = SbxBase::CreateObject( aClass );
232 if( !p )
233 StarBASIC::Error( SbERR_CANNOT_LOAD );
234 else
235 {
236 // Convenience: BASIC als Parent eintragen
237 p->SetParent( pBasic );
238 rPar.Get( 0 )->PutObject( p );
239 }
240 }
241
242 // Error( n )
243
RTLFUNC(Error)244 RTLFUNC(Error)
245 {
246 (void)bWrite;
247
248 if( !pBasic )
249 StarBASIC::Error( SbERR_INTERNAL_ERROR );
250 else
251 {
252 String aErrorMsg;
253 SbError nErr = 0L;
254 sal_Int32 nCode = 0;
255 if( rPar.Count() == 1 )
256 {
257 nErr = StarBASIC::GetErrBasic();
258 aErrorMsg = StarBASIC::GetErrorMsg();
259 }
260 else
261 {
262 nCode = rPar.Get( 1 )->GetLong();
263 if( nCode > 65535L )
264 StarBASIC::Error( SbERR_CONVERSION );
265 else
266 nErr = StarBASIC::GetSfxFromVBError( (sal_uInt16)nCode );
267 }
268
269 bool bVBA = SbiRuntime::isVBAEnabled();
270 String tmpErrMsg;
271 if( bVBA && aErrorMsg.Len() > 0 )
272 {
273 tmpErrMsg = aErrorMsg;
274 }
275 else
276 {
277 pBasic->MakeErrorText( nErr, aErrorMsg );
278 tmpErrMsg = pBasic->GetErrorText();
279 }
280 // If this rtlfunc 'Error' passed a errcode the same as the active Err Objects's
281 // current err then return the description for the error message if it is set
282 // ( complicated isn't it ? )
283 if ( bVBA && rPar.Count() > 1 )
284 {
285 com::sun::star::uno::Reference< ooo::vba::XErrObject > xErrObj( SbxErrObject::getUnoErrObject() );
286 if ( xErrObj.is() && xErrObj->getNumber() == nCode && !xErrObj->getDescription().isEmpty() )
287 tmpErrMsg = xErrObj->getDescription();
288 }
289 rPar.Get( 0 )->PutString( tmpErrMsg );
290 }
291 }
292
293 // Sinus
294
RTLFUNC(Sin)295 RTLFUNC(Sin)
296 {
297 (void)pBasic;
298 (void)bWrite;
299
300 if ( rPar.Count() < 2 )
301 StarBASIC::Error( SbERR_BAD_ARGUMENT );
302 else
303 {
304 SbxVariableRef pArg = rPar.Get( 1 );
305 rPar.Get( 0 )->PutDouble( sin( pArg->GetDouble() ) );
306 }
307 }
308
309 // Cosinus
310
RTLFUNC(Cos)311 RTLFUNC(Cos)
312 {
313 (void)pBasic;
314 (void)bWrite;
315
316 if ( rPar.Count() < 2 )
317 StarBASIC::Error( SbERR_BAD_ARGUMENT );
318 else
319 {
320 SbxVariableRef pArg = rPar.Get( 1 );
321 rPar.Get( 0 )->PutDouble( cos( pArg->GetDouble() ) );
322 }
323 }
324
325 // Atn
326
RTLFUNC(Atn)327 RTLFUNC(Atn)
328 {
329 (void)pBasic;
330 (void)bWrite;
331
332 if ( rPar.Count() < 2 )
333 StarBASIC::Error( SbERR_BAD_ARGUMENT );
334 else
335 {
336 SbxVariableRef pArg = rPar.Get( 1 );
337 rPar.Get( 0 )->PutDouble( atan( pArg->GetDouble() ) );
338 }
339 }
340
341
342
RTLFUNC(Abs)343 RTLFUNC(Abs)
344 {
345 (void)pBasic;
346 (void)bWrite;
347
348 if ( rPar.Count() < 2 )
349 StarBASIC::Error( SbERR_BAD_ARGUMENT );
350 else
351 {
352 SbxVariableRef pArg = rPar.Get( 1 );
353 rPar.Get( 0 )->PutDouble( fabs( pArg->GetDouble() ) );
354 }
355 }
356
357
RTLFUNC(Asc)358 RTLFUNC(Asc)
359 {
360 (void)pBasic;
361 (void)bWrite;
362
363 if ( rPar.Count() < 2 )
364 StarBASIC::Error( SbERR_BAD_ARGUMENT );
365 else
366 {
367 SbxVariableRef pArg = rPar.Get( 1 );
368 String aStr( pArg->GetString() );
369 if ( aStr.Len() == 0 )
370 {
371 StarBASIC::Error( SbERR_BAD_ARGUMENT );
372 rPar.Get(0)->PutEmpty();
373 }
374 else
375 {
376 sal_Unicode aCh = aStr.GetBuffer()[0];
377 rPar.Get(0)->PutLong( aCh );
378 }
379 }
380 }
381
implChr(SbxArray & rPar,bool bChrW)382 void implChr( SbxArray& rPar, bool bChrW )
383 {
384 if ( rPar.Count() < 2 )
385 StarBASIC::Error( SbERR_BAD_ARGUMENT );
386 else
387 {
388 SbxVariableRef pArg = rPar.Get( 1 );
389
390 String aStr;
391 if( !bChrW && SbiRuntime::isVBAEnabled() )
392 {
393 sal_Char c = (sal_Char)pArg->GetByte();
394 ByteString s( c );
395 aStr = String( s, gsl_getSystemTextEncoding() );
396 }
397 else
398 {
399 sal_Unicode aCh = (sal_Unicode)pArg->GetUShort();
400 aStr = String( aCh );
401 }
402 rPar.Get(0)->PutString( aStr );
403 }
404 }
405
RTLFUNC(Chr)406 RTLFUNC(Chr)
407 {
408 (void)pBasic;
409 (void)bWrite;
410
411 bool bChrW = false;
412 implChr( rPar, bChrW );
413 }
414
RTLFUNC(ChrW)415 RTLFUNC(ChrW)
416 {
417 (void)pBasic;
418 (void)bWrite;
419
420 bool bChrW = true;
421 implChr( rPar, bChrW );
422 }
423
424
425 #ifdef UNX
426 #define _MAX_PATH 260
427 #define _PATH_INCR 250
428 #endif
429
RTLFUNC(CurDir)430 RTLFUNC(CurDir)
431 {
432 (void)pBasic;
433 (void)bWrite;
434
435 // #57064 Obwohl diese Funktion nicht mit DirEntry arbeitet, ist sie von
436 // der Anpassung an virtuelle URLs nich betroffen, da bei Nutzung der
437 // DirEntry-Funktionalitaet keine Moeglichkeit besteht, das aktuelle so
438 // zu ermitteln, dass eine virtuelle URL geliefert werden koennte.
439
440 // rPar.Get(0)->PutEmpty();
441 #if defined (WNT) || defined (OS2)
442 int nCurDir = 0; // Current dir // JSM
443 if ( rPar.Count() == 2 )
444 {
445 String aDrive = rPar.Get(1)->GetString();
446 if ( aDrive.Len() != 1 )
447 {
448 StarBASIC::Error( SbERR_BAD_ARGUMENT );
449 return;
450 }
451 else
452 {
453 nCurDir = (int)aDrive.GetBuffer()[0];
454 if ( !isalpha( nCurDir ) )
455 {
456 StarBASIC::Error( SbERR_BAD_ARGUMENT );
457 return;
458 }
459 else
460 nCurDir -= ( 'A' - 1 );
461 }
462 }
463 char* pBuffer = new char[ _MAX_PATH ];
464 #ifdef OS2
465 if( !nCurDir )
466 nCurDir = _getdrive();
467 #endif
468 if ( _getdcwd( nCurDir, pBuffer, _MAX_PATH ) != 0 )
469 rPar.Get(0)->PutString( String::CreateFromAscii( pBuffer ) );
470 else
471 StarBASIC::Error( SbERR_NO_DEVICE );
472 delete [] pBuffer;
473
474 #elif defined( UNX )
475
476 int nSize = _PATH_INCR;
477 char* pMem;
478 while( sal_True )
479 {
480 pMem = new char[nSize];
481 if( !pMem )
482 {
483 StarBASIC::Error( SbERR_NO_MEMORY );
484 return;
485 }
486 if( getcwd( pMem, nSize-1 ) != NULL )
487 {
488 rPar.Get(0)->PutString( String::CreateFromAscii(pMem) );
489 delete [] pMem;
490 return;
491 }
492 if( errno != ERANGE )
493 {
494 StarBASIC::Error( SbERR_INTERNAL_ERROR );
495 delete [] pMem;
496 return;
497 }
498 delete [] pMem;
499 nSize += _PATH_INCR;
500 };
501
502 #endif
503 }
504
RTLFUNC(ChDir)505 RTLFUNC(ChDir) // JSM
506 {
507 (void)bWrite;
508
509 rPar.Get(0)->PutEmpty();
510 if (rPar.Count() == 2)
511 {
512 #ifdef _ENABLE_CUR_DIR
513 String aPath = rPar.Get(1)->GetString();
514 sal_Bool bError = sal_False;
515 #ifdef WNT
516 // #55997 Laut MI hilft es bei File-URLs einen DirEntry zwischenzuschalten
517 // #40996 Harmoniert bei Verwendung der WIN32-Funktion nicht mit getdir
518 DirEntry aEntry( aPath );
519 ByteString aFullPath( aEntry.GetFull(), gsl_getSystemTextEncoding() );
520 if( chdir( aFullPath.GetBuffer()) )
521 bError = sal_True;
522 #else
523 if (!DirEntry(aPath).SetCWD())
524 bError = sal_True;
525 #endif
526 if( bError )
527 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
528 #endif
529 // VBA: track current directory per document type (separately for Writer, Calc, Impress, etc.)
530 if( SbiRuntime::isVBAEnabled() )
531 ::basic::vba::registerCurrentDirectory( getDocumentModel( pBasic ), rPar.Get(1)->GetString() );
532 }
533 else
534 StarBASIC::Error( SbERR_BAD_ARGUMENT );
535 }
536
RTLFUNC(ChDrive)537 RTLFUNC(ChDrive) // JSM
538 {
539 (void)pBasic;
540 (void)bWrite;
541
542 rPar.Get(0)->PutEmpty();
543 if (rPar.Count() == 2)
544 {
545 #ifdef _ENABLE_CUR_DIR
546 // Keine Laufwerke in Unix
547 #ifndef UNX
548 String aPar1 = rPar.Get(1)->GetString();
549
550 #if defined (WNT) || defined (OS2)
551 if (aPar1.Len() > 0)
552 {
553 int nCurDrive = (int)aPar1.GetBuffer()[0]; ;
554 if ( !isalpha( nCurDrive ) )
555 {
556 StarBASIC::Error( SbERR_BAD_ARGUMENT );
557 return;
558 }
559 else
560 nCurDrive -= ( 'A' - 1 );
561 if (_chdrive(nCurDrive))
562 StarBASIC::Error( SbERR_NO_DEVICE );
563 }
564 #endif
565
566 #endif
567 // #ifndef UNX
568 #endif
569 }
570 else
571 StarBASIC::Error( SbERR_BAD_ARGUMENT );
572 }
573
574
575 // Implementation of StepRENAME with UCB
implStepRenameUCB(const String & aSource,const String & aDest)576 void implStepRenameUCB( const String& aSource, const String& aDest )
577 {
578 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
579 if( xSFI.is() )
580 {
581 try
582 {
583 String aSourceFullPath = getFullPath( aSource );
584 if( !xSFI->exists( aSourceFullPath ) )
585 {
586 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
587 return;
588 }
589
590 String aDestFullPath = getFullPath( aDest );
591 if( xSFI->exists( aDestFullPath ) )
592 StarBASIC::Error( SbERR_FILE_EXISTS );
593 else
594 xSFI->move( aSourceFullPath, aDestFullPath );
595 }
596 catch( Exception & )
597 {
598 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
599 }
600 }
601 }
602
603 // Implementation of StepRENAME with OSL
implStepRenameOSL(const String & aSource,const String & aDest)604 void implStepRenameOSL( const String& aSource, const String& aDest )
605 {
606 FileBase::RC nRet = File::move( getFullPathUNC( aSource ), getFullPathUNC( aDest ) );
607 if( nRet != FileBase::E_None )
608 {
609 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
610 }
611 }
612
RTLFUNC(FileCopy)613 RTLFUNC(FileCopy) // JSM
614 {
615 (void)pBasic;
616 (void)bWrite;
617
618 rPar.Get(0)->PutEmpty();
619 if (rPar.Count() == 3)
620 {
621 String aSource = rPar.Get(1)->GetString();
622 String aDest = rPar.Get(2)->GetString();
623 // <-- UCB
624 if( hasUno() )
625 {
626 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
627 if( xSFI.is() )
628 {
629 try
630 {
631 xSFI->copy( getFullPath( aSource ), getFullPath( aDest ) );
632 }
633 catch( Exception & )
634 {
635 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
636 }
637 }
638 }
639 else
640 // --> UCB
641 {
642 #ifdef _OLD_FILE_IMPL
643 DirEntry aSourceDirEntry(aSource);
644 if (aSourceDirEntry.Exists())
645 {
646 if (aSourceDirEntry.CopyTo(DirEntry(aDest),FSYS_ACTION_COPYFILE) != FSYS_ERR_OK)
647 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
648 }
649 else
650 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
651 #else
652 FileBase::RC nRet = File::copy( getFullPathUNC( aSource ), getFullPathUNC( aDest ) );
653 if( nRet != FileBase::E_None )
654 {
655 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
656 }
657 #endif
658 }
659 }
660 else
661 StarBASIC::Error( SbERR_BAD_ARGUMENT );
662 }
663
RTLFUNC(Kill)664 RTLFUNC(Kill) // JSM
665 {
666 (void)pBasic;
667 (void)bWrite;
668
669 rPar.Get(0)->PutEmpty();
670 if (rPar.Count() == 2)
671 {
672 String aFileSpec = rPar.Get(1)->GetString();
673
674 // <-- UCB
675 if( hasUno() )
676 {
677 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
678 if( xSFI.is() )
679 {
680 String aFullPath = getFullPath( aFileSpec );
681 if( !xSFI->exists( aFullPath ) || xSFI->isFolder( aFullPath ) )
682 {
683 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
684 return;
685 }
686 try
687 {
688 xSFI->kill( aFullPath );
689 }
690 catch( Exception & )
691 {
692 StarBASIC::Error( ERRCODE_IO_GENERAL );
693 }
694 }
695 }
696 else
697 // --> UCB
698 {
699 #ifdef _OLD_FILE_IMPL
700 if(DirEntry(aFileSpec).Kill() != FSYS_ERR_OK)
701 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
702 #else
703 File::remove( getFullPathUNC( aFileSpec ) );
704 #endif
705 }
706 }
707 else
708 StarBASIC::Error( SbERR_BAD_ARGUMENT );
709 }
710
RTLFUNC(MkDir)711 RTLFUNC(MkDir) // JSM
712 {
713 (void)pBasic;
714 (void)bWrite;
715
716 rPar.Get(0)->PutEmpty();
717 if (rPar.Count() == 2)
718 {
719 String aPath = rPar.Get(1)->GetString();
720
721 // <-- UCB
722 if( hasUno() )
723 {
724 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
725 if( xSFI.is() )
726 {
727 try
728 {
729 xSFI->createFolder( getFullPath( aPath ) );
730 }
731 catch( Exception & )
732 {
733 StarBASIC::Error( ERRCODE_IO_GENERAL );
734 }
735 }
736 }
737 else
738 // --> UCB
739 {
740 #ifdef _OLD_FILE_IMPL
741 if (!DirEntry(aPath).MakeDir())
742 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
743 #else
744 Directory::create( getFullPathUNC( aPath ) );
745 #endif
746 }
747 }
748 else
749 StarBASIC::Error( SbERR_BAD_ARGUMENT );
750 }
751
752
753 #ifndef _OLD_FILE_IMPL
754
755 // In OSL only empty directories can be deleted
756 // so we have to delete all files recursively
implRemoveDirRecursive(const String & aDirPath)757 void implRemoveDirRecursive( const String& aDirPath )
758 {
759 DirectoryItem aItem;
760 FileBase::RC nRet = DirectoryItem::get( aDirPath, aItem );
761 sal_Bool bExists = (nRet == FileBase::E_None);
762
763 FileStatus aFileStatus( FileStatusMask_Type );
764 nRet = aItem.getFileStatus( aFileStatus );
765 FileStatus::Type aType = aFileStatus.getFileType();
766 sal_Bool bFolder = isFolder( aType );
767
768 if( !bExists || !bFolder )
769 {
770 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
771 return;
772 }
773
774 Directory aDir( aDirPath );
775 nRet = aDir.open();
776 if( nRet != FileBase::E_None )
777 {
778 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
779 return;
780 }
781
782 for( ;; )
783 {
784 DirectoryItem aItem2;
785 nRet = aDir.getNextItem( aItem2 );
786 if( nRet != FileBase::E_None )
787 break;
788
789 // Handle flags
790 FileStatus aFileStatus2( FileStatusMask_Type | FileStatusMask_FileURL );
791 nRet = aItem2.getFileStatus( aFileStatus2 );
792 ::rtl::OUString aPath = aFileStatus2.getFileURL();
793
794 // Directory?
795 FileStatus::Type aType2 = aFileStatus2.getFileType();
796 sal_Bool bFolder2 = isFolder( aType2 );
797 if( bFolder2 )
798 {
799 implRemoveDirRecursive( aPath );
800 }
801 else
802 {
803 File::remove( aPath );
804 }
805 }
806 nRet = aDir.close();
807
808 nRet = Directory::remove( aDirPath );
809 }
810 #endif
811
812
RTLFUNC(RmDir)813 RTLFUNC(RmDir) // JSM
814 {
815 (void)pBasic;
816 (void)bWrite;
817
818 rPar.Get(0)->PutEmpty();
819 if (rPar.Count() == 2)
820 {
821 String aPath = rPar.Get(1)->GetString();
822 // <-- UCB
823 if( hasUno() )
824 {
825 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
826 if( xSFI.is() )
827 {
828 try
829 {
830 if( !xSFI->isFolder( aPath ) )
831 {
832 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
833 return;
834 }
835 SbiInstance* pInst = pINST;
836 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
837 if( bCompatibility )
838 {
839 Sequence< ::rtl::OUString > aContent = xSFI->getFolderContents( aPath, true );
840 sal_Int32 nCount = aContent.getLength();
841 if( nCount > 0 )
842 {
843 StarBASIC::Error( SbERR_ACCESS_ERROR );
844 return;
845 }
846 }
847
848 xSFI->kill( getFullPath( aPath ) );
849 }
850 catch( Exception & )
851 {
852 StarBASIC::Error( ERRCODE_IO_GENERAL );
853 }
854 }
855 }
856 else
857 // --> UCB
858 {
859 #ifdef _OLD_FILE_IMPL
860 DirEntry aDirEntry(aPath);
861 if (aDirEntry.Kill() != FSYS_ERR_OK)
862 StarBASIC::Error( SbERR_PATH_NOT_FOUND );
863 #else
864 implRemoveDirRecursive( getFullPathUNC( aPath ) );
865 #endif
866 }
867 }
868 else
869 StarBASIC::Error( SbERR_BAD_ARGUMENT );
870 }
871
RTLFUNC(SendKeys)872 RTLFUNC(SendKeys) // JSM
873 {
874 (void)pBasic;
875 (void)bWrite;
876
877 rPar.Get(0)->PutEmpty();
878 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
879 }
880
RTLFUNC(Exp)881 RTLFUNC(Exp)
882 {
883 (void)pBasic;
884 (void)bWrite;
885
886 if( rPar.Count() < 2 )
887 StarBASIC::Error( SbERR_BAD_ARGUMENT );
888 else
889 {
890 double aDouble = rPar.Get( 1 )->GetDouble();
891 aDouble = exp( aDouble );
892 checkArithmeticOverflow( aDouble );
893 rPar.Get( 0 )->PutDouble( aDouble );
894 }
895 }
896
RTLFUNC(FileLen)897 RTLFUNC(FileLen)
898 {
899 (void)pBasic;
900 (void)bWrite;
901
902 if ( rPar.Count() < 2 )
903 StarBASIC::Error( SbERR_BAD_ARGUMENT );
904 else
905 {
906 SbxVariableRef pArg = rPar.Get( 1 );
907 String aStr( pArg->GetString() );
908 sal_Int32 nLen = 0;
909 // <-- UCB
910 if( hasUno() )
911 {
912 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
913 if( xSFI.is() )
914 {
915 try
916 {
917 nLen = xSFI->getSize( getFullPath( aStr ) );
918 }
919 catch( Exception & )
920 {
921 StarBASIC::Error( ERRCODE_IO_GENERAL );
922 }
923 }
924 }
925 else
926 // --> UCB
927 {
928 #ifdef _OLD_FILE_IMPL
929 FileStat aStat = DirEntry( aStr );
930 nLen = aStat.GetSize();
931 #else
932 DirectoryItem aItem;
933 FileBase::RC nRet = DirectoryItem::get( getFullPathUNC( aStr ), aItem );
934 FileStatus aFileStatus( FileStatusMask_FileSize );
935 nRet = aItem.getFileStatus( aFileStatus );
936 nLen = (sal_Int32)aFileStatus.getFileSize();
937 #endif
938 }
939 rPar.Get(0)->PutLong( (long)nLen );
940 }
941 }
942
943
RTLFUNC(Hex)944 RTLFUNC(Hex)
945 {
946 (void)pBasic;
947 (void)bWrite;
948
949 if ( rPar.Count() < 2 )
950 StarBASIC::Error( SbERR_BAD_ARGUMENT );
951 else
952 {
953 char aBuffer[16];
954 SbxVariableRef pArg = rPar.Get( 1 );
955 if ( pArg->IsInteger() )
956 snprintf( aBuffer, sizeof(aBuffer), "%X", pArg->GetInteger() );
957 else
958 snprintf( aBuffer, sizeof(aBuffer), "%lX", static_cast<long unsigned int>(pArg->GetLong()) );
959 rPar.Get(0)->PutString( String::CreateFromAscii( aBuffer ) );
960 }
961 }
962
963 // InStr( [start],string,string,[compare] )
964
RTLFUNC(InStr)965 RTLFUNC(InStr)
966 {
967 (void)pBasic;
968 (void)bWrite;
969
970 sal_uIntPtr nArgCount = rPar.Count()-1;
971 if ( nArgCount < 2 )
972 StarBASIC::Error( SbERR_BAD_ARGUMENT );
973 else
974 {
975 sal_uInt16 nStartPos = 1;
976
977 sal_uInt16 nFirstStringPos = 1;
978 if ( nArgCount >= 3 )
979 {
980 sal_Int32 lStartPos = rPar.Get(1)->GetLong();
981 if( lStartPos <= 0 || lStartPos > 0xffff )
982 {
983 StarBASIC::Error( SbERR_BAD_ARGUMENT );
984 lStartPos = 1;
985 }
986 nStartPos = (sal_uInt16)lStartPos;
987 nFirstStringPos++;
988 }
989
990 SbiInstance* pInst = pINST;
991 int bTextMode;
992 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
993 if( bCompatibility )
994 {
995 SbiRuntime* pRT = pInst ? pInst->pRun : NULL;
996 bTextMode = pRT ? pRT->GetImageFlag( SBIMG_COMPARETEXT ) : sal_False;
997 }
998 else
999 {
1000 bTextMode = 1;
1001 }
1002 if ( nArgCount == 4 )
1003 bTextMode = rPar.Get(4)->GetInteger();
1004
1005 sal_uInt16 nPos;
1006 const String& rToken = rPar.Get(nFirstStringPos+1)->GetString();
1007
1008 // #97545 Always find empty string
1009 if( !rToken.Len() )
1010 {
1011 nPos = nStartPos;
1012 }
1013 else
1014 {
1015 if( !bTextMode )
1016 {
1017 const String& rStr1 = rPar.Get(nFirstStringPos)->GetString();
1018
1019 nPos = rStr1.Search( rToken, nStartPos-1 );
1020 if ( nPos == STRING_NOTFOUND )
1021 nPos = 0;
1022 else
1023 nPos++;
1024 }
1025 else
1026 {
1027 String aStr1 = rPar.Get(nFirstStringPos)->GetString();
1028 String aToken = rToken;
1029
1030 aStr1.ToUpperAscii();
1031 aToken.ToUpperAscii();
1032
1033 nPos = aStr1.Search( aToken, nStartPos-1 );
1034 if ( nPos == STRING_NOTFOUND )
1035 nPos = 0;
1036 else
1037 nPos++;
1038 }
1039 }
1040 rPar.Get(0)->PutLong( nPos );
1041 }
1042 }
1043
1044
1045 // InstrRev(string1, string2[, start[, compare]])
1046
RTLFUNC(InStrRev)1047 RTLFUNC(InStrRev)
1048 {
1049 (void)pBasic;
1050 (void)bWrite;
1051
1052 sal_uIntPtr nArgCount = rPar.Count()-1;
1053 if ( nArgCount < 2 )
1054 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1055 else
1056 {
1057 String aStr1 = rPar.Get(1)->GetString();
1058 String aToken = rPar.Get(2)->GetString();
1059
1060 sal_Int32 lStartPos = -1;
1061 if ( nArgCount >= 3 )
1062 {
1063 lStartPos = rPar.Get(3)->GetLong();
1064 if( (lStartPos <= 0 && lStartPos != -1) || lStartPos > 0xffff )
1065 {
1066 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1067 lStartPos = -1;
1068 }
1069 }
1070
1071 SbiInstance* pInst = pINST;
1072 int bTextMode;
1073 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1074 if( bCompatibility )
1075 {
1076 SbiRuntime* pRT = pInst ? pInst->pRun : NULL;
1077 bTextMode = pRT ? pRT->GetImageFlag( SBIMG_COMPARETEXT ) : sal_False;
1078 }
1079 else
1080 {
1081 bTextMode = 1;
1082 }
1083 if ( nArgCount == 4 )
1084 bTextMode = rPar.Get(4)->GetInteger();
1085
1086 sal_uInt16 nStrLen = aStr1.Len();
1087 sal_uInt16 nStartPos = lStartPos == -1 ? nStrLen : (sal_uInt16)lStartPos;
1088
1089 sal_uInt16 nPos = 0;
1090 if( nStartPos <= nStrLen )
1091 {
1092 sal_uInt16 nTokenLen = aToken.Len();
1093 if( !nTokenLen )
1094 {
1095 // Always find empty string
1096 nPos = nStartPos;
1097 }
1098 else if( nStrLen > 0 )
1099 {
1100 if( !bTextMode )
1101 {
1102 ::rtl::OUString aOUStr1 ( aStr1 );
1103 ::rtl::OUString aOUToken( aToken );
1104 sal_Int32 nRet = aOUStr1.lastIndexOf( aOUToken, nStartPos );
1105 if( nRet == -1 )
1106 nPos = 0;
1107 else
1108 nPos = (sal_uInt16)nRet + 1;
1109 }
1110 else
1111 {
1112 aStr1.ToUpperAscii();
1113 aToken.ToUpperAscii();
1114
1115 ::rtl::OUString aOUStr1 ( aStr1 );
1116 ::rtl::OUString aOUToken( aToken );
1117 sal_Int32 nRet = aOUStr1.lastIndexOf( aOUToken, nStartPos );
1118
1119 if( nRet == -1 )
1120 nPos = 0;
1121 else
1122 nPos = (sal_uInt16)nRet + 1;
1123 }
1124 }
1125 }
1126 rPar.Get(0)->PutLong( nPos );
1127 }
1128 }
1129
1130
1131 /*
1132 Int( 2.8 ) = 2.0
1133 Int( -2.8 ) = -3.0
1134 Fix( 2.8 ) = 2.0
1135 Fix( -2.8 ) = -2.0 <- !!
1136 */
1137
RTLFUNC(Int)1138 RTLFUNC(Int)
1139 {
1140 (void)pBasic;
1141 (void)bWrite;
1142
1143 if ( rPar.Count() < 2 )
1144 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1145 else
1146 {
1147 SbxVariableRef pArg = rPar.Get( 1 );
1148 double aDouble= pArg->GetDouble();
1149 /*
1150 floor( 2.8 ) = 2.0
1151 floor( -2.8 ) = -3.0
1152 */
1153 aDouble = floor( aDouble );
1154 rPar.Get(0)->PutDouble( aDouble );
1155 }
1156 }
1157
1158
1159
RTLFUNC(Fix)1160 RTLFUNC(Fix)
1161 {
1162 (void)pBasic;
1163 (void)bWrite;
1164
1165 if ( rPar.Count() < 2 )
1166 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1167 else
1168 {
1169 SbxVariableRef pArg = rPar.Get( 1 );
1170 double aDouble = pArg->GetDouble();
1171 if ( aDouble >= 0.0 )
1172 aDouble = floor( aDouble );
1173 else
1174 aDouble = ceil( aDouble );
1175 rPar.Get(0)->PutDouble( aDouble );
1176 }
1177 }
1178
1179
RTLFUNC(LCase)1180 RTLFUNC(LCase)
1181 {
1182 (void)pBasic;
1183 (void)bWrite;
1184
1185 if ( rPar.Count() < 2 )
1186 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1187 else
1188 {
1189 CharClass& rCharClass = GetCharClass();
1190 String aStr( rPar.Get(1)->GetString() );
1191 rCharClass.toLower( aStr );
1192 rPar.Get(0)->PutString( aStr );
1193 }
1194 }
1195
RTLFUNC(Left)1196 RTLFUNC(Left)
1197 {
1198 (void)pBasic;
1199 (void)bWrite;
1200
1201 if ( rPar.Count() < 3 )
1202 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1203 else
1204 {
1205 String aStr( rPar.Get(1)->GetString() );
1206 sal_Int32 lResultLen = rPar.Get(2)->GetLong();
1207 if( lResultLen > 0xffff )
1208 {
1209 lResultLen = 0xffff;
1210 }
1211 else if( lResultLen < 0 )
1212 {
1213 lResultLen = 0;
1214 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1215 }
1216 aStr.Erase( (sal_uInt16)lResultLen );
1217 rPar.Get(0)->PutString( aStr );
1218 }
1219 }
1220
RTLFUNC(Log)1221 RTLFUNC(Log)
1222 {
1223 (void)pBasic;
1224 (void)bWrite;
1225
1226 if ( rPar.Count() < 2 )
1227 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1228 else
1229 {
1230 double aArg = rPar.Get(1)->GetDouble();
1231 if ( aArg > 0 )
1232 {
1233 double d = log( aArg );
1234 checkArithmeticOverflow( d );
1235 rPar.Get( 0 )->PutDouble( d );
1236 }
1237 else
1238 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1239 }
1240 }
1241
RTLFUNC(LTrim)1242 RTLFUNC(LTrim)
1243 {
1244 (void)pBasic;
1245 (void)bWrite;
1246
1247 if ( rPar.Count() < 2 )
1248 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1249 else
1250 {
1251 String aStr( rPar.Get(1)->GetString() );
1252 aStr.EraseLeadingChars();
1253 rPar.Get(0)->PutString( aStr );
1254 }
1255 }
1256
1257
1258 // Mid( String, nStart, nLength )
1259
RTLFUNC(Mid)1260 RTLFUNC(Mid)
1261 {
1262 (void)pBasic;
1263 (void)bWrite;
1264
1265 sal_uIntPtr nArgCount = rPar.Count()-1;
1266 if ( nArgCount < 2 )
1267 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1268 else
1269 {
1270 // #23178: Funktionalitaet von Mid$ als Anweisung nachbilden, indem
1271 // als weiterer (4.) Parameter ein Ersetzungsstring aufgenommen wird.
1272 // Anders als im Original kann in dieser Variante der 3. Parameter
1273 // nLength nicht weggelassen werden. Ist ueber bWrite schon vorgesehen.
1274 if( nArgCount == 4 )
1275 bWrite = sal_True;
1276
1277 String aArgStr = rPar.Get(1)->GetString();
1278 sal_uInt16 nStartPos = (sal_uInt16)(rPar.Get(2)->GetLong() );
1279 if ( nStartPos == 0 )
1280 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1281 else
1282 {
1283 nStartPos--;
1284 sal_uInt16 nLen = 0xffff;
1285 bool bWriteNoLenParam = false;
1286 if ( nArgCount == 3 || bWrite )
1287 {
1288 sal_Int32 n = rPar.Get(3)->GetLong();
1289 if( bWrite && n == -1 )
1290 bWriteNoLenParam = true;
1291 nLen = (sal_uInt16)n;
1292 }
1293 String aResultStr;
1294 if ( bWrite )
1295 {
1296 SbiInstance* pInst = pINST;
1297 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1298 if( bCompatibility )
1299 {
1300 sal_uInt16 nArgLen = aArgStr.Len();
1301 if( nStartPos + 1 > nArgLen )
1302 {
1303 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1304 return;
1305 }
1306
1307 String aReplaceStr = rPar.Get(4)->GetString();
1308 sal_uInt16 nReplaceStrLen = aReplaceStr.Len();
1309 sal_uInt16 nReplaceLen;
1310 if( bWriteNoLenParam )
1311 {
1312 nReplaceLen = nReplaceStrLen;
1313 }
1314 else
1315 {
1316 nReplaceLen = nLen;
1317 if( nReplaceLen > nReplaceStrLen )
1318 nReplaceLen = nReplaceStrLen;
1319 }
1320
1321 sal_uInt16 nReplaceEndPos = nStartPos + nReplaceLen;
1322 if( nReplaceEndPos > nArgLen )
1323 nReplaceLen -= (nReplaceEndPos - nArgLen);
1324
1325 aResultStr = aArgStr;
1326 sal_uInt16 nErase = nReplaceLen;
1327 aResultStr.Erase( nStartPos, nErase );
1328 aResultStr.Insert( aReplaceStr, 0, nReplaceLen, nStartPos );
1329 }
1330 else
1331 {
1332 aResultStr = aArgStr;
1333 aResultStr.Erase( nStartPos, nLen );
1334 aResultStr.Insert(rPar.Get(4)->GetString(),0,nLen,nStartPos);
1335 }
1336
1337 rPar.Get(1)->PutString( aResultStr );
1338 }
1339 else
1340 {
1341 aResultStr = aArgStr.Copy( nStartPos, nLen );
1342 rPar.Get(0)->PutString( aResultStr );
1343 }
1344 }
1345 }
1346 }
1347
RTLFUNC(Oct)1348 RTLFUNC(Oct)
1349 {
1350 (void)pBasic;
1351 (void)bWrite;
1352
1353 if ( rPar.Count() < 2 )
1354 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1355 else
1356 {
1357 char aBuffer[16];
1358 SbxVariableRef pArg = rPar.Get( 1 );
1359 if ( pArg->IsInteger() )
1360 snprintf( aBuffer, sizeof(aBuffer), "%o", pArg->GetInteger() );
1361 else
1362 snprintf( aBuffer, sizeof(aBuffer), "%lo", static_cast<long unsigned int>(pArg->GetLong()) );
1363 rPar.Get(0)->PutString( String::CreateFromAscii( aBuffer ) );
1364 }
1365 }
1366
1367 // Replace(expression, find, replace[, start[, count[, compare]]])
1368
RTLFUNC(Replace)1369 RTLFUNC(Replace)
1370 {
1371 (void)pBasic;
1372 (void)bWrite;
1373
1374 sal_uIntPtr nArgCount = rPar.Count()-1;
1375 if ( nArgCount < 3 || nArgCount > 6 )
1376 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1377 else
1378 {
1379 String aExpStr = rPar.Get(1)->GetString();
1380 String aFindStr = rPar.Get(2)->GetString();
1381 String aReplaceStr = rPar.Get(3)->GetString();
1382
1383 sal_Int32 lStartPos = 1;
1384 if ( nArgCount >= 4 )
1385 {
1386 if( rPar.Get(4)->GetType() != SbxEMPTY )
1387 lStartPos = rPar.Get(4)->GetLong();
1388 if( lStartPos < 1 || lStartPos > 0xffff )
1389 {
1390 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1391 lStartPos = 1;
1392 }
1393 }
1394
1395 sal_Int32 lCount = -1;
1396 if( nArgCount >=5 )
1397 {
1398 if( rPar.Get(5)->GetType() != SbxEMPTY )
1399 lCount = rPar.Get(5)->GetLong();
1400 if( lCount < -1 || lCount > 0xffff )
1401 {
1402 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1403 lCount = -1;
1404 }
1405 }
1406
1407 SbiInstance* pInst = pINST;
1408 int bTextMode;
1409 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1410 if( bCompatibility )
1411 {
1412 SbiRuntime* pRT = pInst ? pInst->pRun : NULL;
1413 bTextMode = pRT ? pRT->GetImageFlag( SBIMG_COMPARETEXT ) : sal_False;
1414 }
1415 else
1416 {
1417 bTextMode = 1;
1418 }
1419 if ( nArgCount == 6 )
1420 bTextMode = rPar.Get(6)->GetInteger();
1421
1422 sal_uInt16 nExpStrLen = aExpStr.Len();
1423 sal_uInt16 nFindStrLen = aFindStr.Len();
1424 sal_uInt16 nReplaceStrLen = aReplaceStr.Len();
1425
1426 if( lStartPos <= nExpStrLen )
1427 {
1428 sal_uInt16 nPos = static_cast<sal_uInt16>( lStartPos - 1 );
1429 sal_uInt16 nCounts = 0;
1430 while( lCount == -1 || lCount > nCounts )
1431 {
1432 String aSrcStr( aExpStr );
1433 if( bTextMode )
1434 {
1435 aSrcStr.ToUpperAscii();
1436 aFindStr.ToUpperAscii();
1437 }
1438 nPos = aSrcStr.Search( aFindStr, nPos );
1439 if( nPos != STRING_NOTFOUND )
1440 {
1441 aExpStr.Replace( nPos, nFindStrLen, aReplaceStr );
1442 nPos = nPos + nReplaceStrLen;
1443 nCounts++;
1444 }
1445 else
1446 {
1447 break;
1448 }
1449 }
1450 }
1451 rPar.Get(0)->PutString( aExpStr.Copy( static_cast<sal_uInt16>(lStartPos - 1) ) );
1452 }
1453 }
1454
RTLFUNC(Right)1455 RTLFUNC(Right)
1456 {
1457 (void)pBasic;
1458 (void)bWrite;
1459
1460 if ( rPar.Count() < 3 )
1461 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1462 else
1463 {
1464 const String& rStr = rPar.Get(1)->GetString();
1465 sal_Int32 lResultLen = rPar.Get(2)->GetLong();
1466 if( lResultLen > 0xffff )
1467 {
1468 lResultLen = 0xffff;
1469 }
1470 else if( lResultLen < 0 )
1471 {
1472 lResultLen = 0;
1473 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1474 }
1475 sal_uInt16 nResultLen = (sal_uInt16)lResultLen;
1476 sal_uInt16 nStrLen = rStr.Len();
1477 if ( nResultLen > nStrLen )
1478 nResultLen = nStrLen;
1479 String aResultStr = rStr.Copy( nStrLen-nResultLen );
1480 rPar.Get(0)->PutString( aResultStr );
1481 }
1482 }
1483
RTLFUNC(RTL)1484 RTLFUNC(RTL)
1485 {
1486 (void)pBasic;
1487 (void)bWrite;
1488
1489 rPar.Get( 0 )->PutObject( pBasic->getRTL() );
1490 }
1491
RTLFUNC(RTrim)1492 RTLFUNC(RTrim)
1493 {
1494 (void)pBasic;
1495 (void)bWrite;
1496
1497 if ( rPar.Count() < 2 )
1498 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1499 else
1500 {
1501 String aStr( rPar.Get(1)->GetString() );
1502 aStr.EraseTrailingChars();
1503 rPar.Get(0)->PutString( aStr );
1504 }
1505 }
1506
RTLFUNC(Sgn)1507 RTLFUNC(Sgn)
1508 {
1509 (void)pBasic;
1510 (void)bWrite;
1511
1512 if ( rPar.Count() < 2 )
1513 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1514 else
1515 {
1516 double aDouble = rPar.Get(1)->GetDouble();
1517 sal_Int16 nResult = 0;
1518 if ( aDouble > 0 )
1519 nResult = 1;
1520 else if ( aDouble < 0 )
1521 nResult = -1;
1522 rPar.Get(0)->PutInteger( nResult );
1523 }
1524 }
1525
RTLFUNC(Space)1526 RTLFUNC(Space)
1527 {
1528 (void)pBasic;
1529 (void)bWrite;
1530
1531 if ( rPar.Count() < 2 )
1532 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1533 else
1534 {
1535 String aStr;
1536 aStr.Fill( (sal_uInt16)(rPar.Get(1)->GetLong() ));
1537 rPar.Get(0)->PutString( aStr );
1538 }
1539 }
1540
RTLFUNC(Spc)1541 RTLFUNC(Spc)
1542 {
1543 (void)pBasic;
1544 (void)bWrite;
1545
1546 if ( rPar.Count() < 2 )
1547 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1548 else
1549 {
1550 String aStr;
1551 aStr.Fill( (sal_uInt16)(rPar.Get(1)->GetLong() ));
1552 rPar.Get(0)->PutString( aStr );
1553 }
1554 }
1555
RTLFUNC(Sqr)1556 RTLFUNC(Sqr)
1557 {
1558 (void)pBasic;
1559 (void)bWrite;
1560
1561 if ( rPar.Count() < 2 )
1562 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1563 else
1564 {
1565 double aDouble = rPar.Get(1)->GetDouble();
1566 if ( aDouble >= 0 )
1567 rPar.Get(0)->PutDouble( sqrt( aDouble ));
1568 else
1569 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1570 }
1571 }
1572
RTLFUNC(Str)1573 RTLFUNC(Str)
1574 {
1575 (void)pBasic;
1576 (void)bWrite;
1577
1578 if ( rPar.Count() < 2 )
1579 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1580 else
1581 {
1582 String aStr;
1583 SbxVariableRef pArg = rPar.Get( 1 );
1584 pArg->Format( aStr );
1585
1586 // Numbers start with a space
1587 if( pArg->IsNumericRTL() )
1588 {
1589 // Kommas durch Punkte ersetzen, damit es symmetrisch zu Val ist!
1590 aStr.SearchAndReplace( ',', '.' );
1591
1592 SbiInstance* pInst = pINST;
1593 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1594 if( bCompatibility )
1595 {
1596 xub_StrLen nLen = aStr.Len();
1597
1598 const sal_Unicode* pBuf = aStr.GetBuffer();
1599
1600 bool bNeg = ( pBuf[0] == '-' );
1601 sal_uInt16 iZeroSearch = 0;
1602 if( bNeg )
1603 iZeroSearch++;
1604
1605 sal_uInt16 iNext = iZeroSearch + 1;
1606 if( pBuf[iZeroSearch] == '0' && nLen > iNext && pBuf[iNext] == '.' )
1607 {
1608 aStr.Erase( iZeroSearch, 1 );
1609 pBuf = aStr.GetBuffer();
1610 }
1611 if( !bNeg )
1612 aStr.Insert( ' ', 0 );
1613 }
1614 else
1615 aStr.Insert( ' ', 0 );
1616 }
1617 rPar.Get(0)->PutString( aStr );
1618 }
1619 }
1620
RTLFUNC(StrComp)1621 RTLFUNC(StrComp)
1622 {
1623 (void)pBasic;
1624 (void)bWrite;
1625
1626 if ( rPar.Count() < 3 )
1627 {
1628 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1629 rPar.Get(0)->PutEmpty();
1630 return;
1631 }
1632 const String& rStr1 = rPar.Get(1)->GetString();
1633 const String& rStr2 = rPar.Get(2)->GetString();
1634
1635 SbiInstance* pInst = pINST;
1636 sal_Int16 nTextCompare;
1637 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
1638 if( bCompatibility )
1639 {
1640 SbiRuntime* pRT = pInst ? pInst->pRun : NULL;
1641 nTextCompare = pRT ? pRT->GetImageFlag( SBIMG_COMPARETEXT ) : sal_False;
1642 }
1643 else
1644 {
1645 nTextCompare = sal_True;
1646 }
1647 if ( rPar.Count() == 4 )
1648 nTextCompare = rPar.Get(3)->GetInteger();
1649
1650 if( !bCompatibility )
1651 nTextCompare = !nTextCompare;
1652
1653 StringCompare aResult;
1654 sal_Int32 nRetValue = 0;
1655 if( nTextCompare )
1656 {
1657 ::utl::TransliterationWrapper* pTransliterationWrapper = GetSbData()->pTransliterationWrapper;
1658 if( !pTransliterationWrapper )
1659 {
1660 com::sun::star::uno::Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory();
1661 pTransliterationWrapper = GetSbData()->pTransliterationWrapper =
1662 new ::utl::TransliterationWrapper( xSMgr,
1663 ::com::sun::star::i18n::TransliterationModules_IGNORE_CASE |
1664 ::com::sun::star::i18n::TransliterationModules_IGNORE_KANA |
1665 ::com::sun::star::i18n::TransliterationModules_IGNORE_WIDTH );
1666 }
1667
1668 LanguageType eLangType = GetpApp()->GetSettings().GetLanguage();
1669 pTransliterationWrapper->loadModuleIfNeeded( eLangType );
1670 nRetValue = pTransliterationWrapper->compareString( rStr1, rStr2 );
1671 }
1672 else
1673 {
1674 aResult = rStr1.CompareTo( rStr2 );
1675 if ( aResult == COMPARE_LESS )
1676 nRetValue = -1;
1677 else if ( aResult == COMPARE_GREATER )
1678 nRetValue = 1;
1679 }
1680
1681 rPar.Get(0)->PutInteger( sal::static_int_cast< sal_Int16 >( nRetValue ) );
1682 }
1683
RTLFUNC(String)1684 RTLFUNC(String)
1685 {
1686 (void)pBasic;
1687 (void)bWrite;
1688
1689 if ( rPar.Count() < 2 )
1690 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1691 else
1692 {
1693 String aStr;
1694 sal_Unicode aFiller;
1695 sal_Int32 lCount = rPar.Get(1)->GetLong();
1696 if( lCount < 0 || lCount > 0xffff )
1697 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1698 sal_uInt16 nCount = (sal_uInt16)lCount;
1699 if( rPar.Get(2)->GetType() == SbxINTEGER )
1700 aFiller = (sal_Unicode)rPar.Get(2)->GetInteger();
1701 else
1702 {
1703 const String& rStr = rPar.Get(2)->GetString();
1704 aFiller = rStr.GetBuffer()[0];
1705 }
1706 aStr.Fill( nCount, aFiller );
1707 rPar.Get(0)->PutString( aStr );
1708 }
1709 }
1710
RTLFUNC(Tab)1711 RTLFUNC(Tab)
1712 {
1713 (void)pBasic;
1714 (void)bWrite;
1715
1716 if ( rPar.Count() < 2 )
1717 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1718 else
1719 {
1720 String aStr;
1721 aStr.Fill( (sal_uInt16)(rPar.Get(1)->GetLong() ), '\t');
1722 rPar.Get(0)->PutString( aStr );
1723 }
1724 }
1725
RTLFUNC(Tan)1726 RTLFUNC(Tan)
1727 {
1728 (void)pBasic;
1729 (void)bWrite;
1730
1731 if ( rPar.Count() < 2 )
1732 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1733 else
1734 {
1735 SbxVariableRef pArg = rPar.Get( 1 );
1736 rPar.Get( 0 )->PutDouble( tan( pArg->GetDouble() ) );
1737 }
1738 }
1739
RTLFUNC(UCase)1740 RTLFUNC(UCase)
1741 {
1742 (void)pBasic;
1743 (void)bWrite;
1744
1745 if ( rPar.Count() < 2 )
1746 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1747 else
1748 {
1749 CharClass& rCharClass = GetCharClass();
1750 String aStr( rPar.Get(1)->GetString() );
1751 rCharClass.toUpper( aStr );
1752 rPar.Get(0)->PutString( aStr );
1753 }
1754 }
1755
1756
RTLFUNC(Val)1757 RTLFUNC(Val)
1758 {
1759 (void)pBasic;
1760 (void)bWrite;
1761
1762 if ( rPar.Count() < 2 )
1763 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1764 else
1765 {
1766 double nResult = 0.0;
1767 char* pEndPtr;
1768
1769 String aStr( rPar.Get(1)->GetString() );
1770 // lt. Mikkysoft bei Kommas abbrechen!
1771 // for( sal_uInt16 n=0; n < aStr.Len(); n++ )
1772 // if( aStr[n] == ',' ) aStr[n] = '.';
1773
1774 FilterWhiteSpace( aStr );
1775 if ( aStr.GetBuffer()[0] == '&' && aStr.Len() > 1 )
1776 {
1777 int nRadix = 10;
1778 char aChar = (char)aStr.GetBuffer()[1];
1779 if ( aChar == 'h' || aChar == 'H' )
1780 nRadix = 16;
1781 else if ( aChar == 'o' || aChar == 'O' )
1782 nRadix = 8;
1783 if ( nRadix != 10 )
1784 {
1785 ByteString aByteStr( aStr, gsl_getSystemTextEncoding() );
1786 sal_Int16 nlResult = (sal_Int16)strtol( aByteStr.GetBuffer()+2, &pEndPtr, nRadix);
1787 nResult = (double)nlResult;
1788 }
1789 }
1790 else
1791 {
1792 // #57844 Lokalisierte Funktion benutzen
1793 nResult = ::rtl::math::stringToDouble( aStr, '.', ',', NULL, NULL );
1794 checkArithmeticOverflow( nResult );
1795 // ATL: nResult = strtod( aStr.GetStr(), &pEndPtr );
1796 }
1797
1798 rPar.Get(0)->PutDouble( nResult );
1799 }
1800 }
1801
1802
1803 // Helper functions for date conversion
implGetDateDay(double aDate)1804 sal_Int16 implGetDateDay( double aDate )
1805 {
1806 aDate -= 2.0; // normieren: 1.1.1900 => 0.0
1807 aDate = floor( aDate );
1808 Date aRefDate( 1, 1, 1900 );
1809 aRefDate += (sal_uIntPtr)aDate;
1810
1811 sal_Int16 nRet = (sal_Int16)( aRefDate.GetDay() );
1812 return nRet;
1813 }
1814
implGetDateMonth(double aDate)1815 sal_Int16 implGetDateMonth( double aDate )
1816 {
1817 Date aRefDate( 1,1,1900 );
1818 long nDays = (long)aDate;
1819 nDays -= 2; // normieren: 1.1.1900 => 0.0
1820 aRefDate += nDays;
1821 sal_Int16 nRet = (sal_Int16)( aRefDate.GetMonth() );
1822 return nRet;
1823 }
1824
implGetDateYear(double aDate)1825 sal_Int16 implGetDateYear( double aDate )
1826 {
1827 Date aRefDate( 1,1,1900 );
1828 long nDays = (long) aDate;
1829 nDays -= 2; // normieren: 1.1.1900 => 0.0
1830 aRefDate += nDays;
1831 sal_Int16 nRet = (sal_Int16)( aRefDate.GetYear() );
1832 return nRet;
1833 }
1834
implDateSerial(sal_Int16 nYear,sal_Int16 nMonth,sal_Int16 nDay,double & rdRet)1835 sal_Bool implDateSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay, double& rdRet )
1836 {
1837 if ( nYear < 30 && SbiRuntime::isVBAEnabled() )
1838 nYear += 2000;
1839 else if ( nYear < 100 )
1840 nYear += 1900;
1841 Date aCurDate( nDay, nMonth, nYear );
1842 if ((nYear < 100 || nYear > 9999) )
1843 {
1844 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1845 return sal_False;
1846 }
1847 if ( !SbiRuntime::isVBAEnabled() )
1848 {
1849 if ( (nMonth < 1 || nMonth > 12 )||
1850 (nDay < 1 || nDay > 31 ) )
1851 {
1852 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1853 return sal_False;
1854 }
1855 }
1856 else
1857 {
1858 // grab the year & month
1859 aCurDate = Date( 1, (( nMonth % 12 ) > 0 ) ? ( nMonth % 12 ) : 12 + ( nMonth % 12 ), nYear );
1860
1861 // adjust year based on month value
1862 // e.g. 2000, 0, xx = 1999, 12, xx ( or December of the previous year )
1863 // 2000, 13, xx = 2001, 1, xx ( or January of the following year )
1864 if( ( nMonth < 1 ) || ( nMonth > 12 ) )
1865 {
1866 // inacurrate around leap year, don't use days to calculate,
1867 // just modify the months directory
1868 sal_Int16 nYearAdj = ( nMonth /12 ); // default to positive months inputed
1869 if ( nMonth <=0 )
1870 nYearAdj = ( ( nMonth -12 ) / 12 );
1871 aCurDate.SetYear( aCurDate.GetYear() + nYearAdj );
1872 }
1873
1874 // adjust day value,
1875 // e.g. 2000, 2, 0 = 2000, 1, 31 or the last day of the previous month
1876 // 2000, 1, 32 = 2000, 2, 1 or the first day of the following month
1877 if( ( nDay < 1 ) || ( nDay > aCurDate.GetDaysInMonth() ) )
1878 aCurDate += nDay - 1;
1879 else
1880 aCurDate.SetDay( nDay );
1881 }
1882
1883 long nDiffDays = GetDayDiff( aCurDate );
1884 rdRet = (double)nDiffDays;
1885 return sal_True;
1886 }
1887
1888 // Function to convert date to ISO 8601 date format
RTLFUNC(CDateToIso)1889 RTLFUNC(CDateToIso)
1890 {
1891 (void)pBasic;
1892 (void)bWrite;
1893
1894 if ( rPar.Count() == 2 )
1895 {
1896 double aDate = rPar.Get(1)->GetDate();
1897
1898 char Buffer[9];
1899 snprintf( Buffer, sizeof( Buffer ), "%04d%02d%02d",
1900 implGetDateYear( aDate ),
1901 implGetDateMonth( aDate ),
1902 implGetDateDay( aDate ) );
1903 String aRetStr = String::CreateFromAscii( Buffer );
1904 rPar.Get(0)->PutString( aRetStr );
1905 }
1906 else
1907 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1908 }
1909
1910 // Function to convert date from ISO 8601 date format
RTLFUNC(CDateFromIso)1911 RTLFUNC(CDateFromIso)
1912 {
1913 (void)pBasic;
1914 (void)bWrite;
1915
1916 if ( rPar.Count() == 2 )
1917 {
1918 String aStr = rPar.Get(1)->GetString();
1919 sal_Int16 iMonthStart = aStr.Len() - 4;
1920 String aYearStr = aStr.Copy( 0, iMonthStart );
1921 String aMonthStr = aStr.Copy( iMonthStart, 2 );
1922 String aDayStr = aStr.Copy( iMonthStart+2, 2 );
1923
1924 double dDate;
1925 if( implDateSerial( (sal_Int16)aYearStr.ToInt32(),
1926 (sal_Int16)aMonthStr.ToInt32(), (sal_Int16)aDayStr.ToInt32(), dDate ) )
1927 {
1928 rPar.Get(0)->PutDate( dDate );
1929 }
1930 }
1931 else
1932 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1933 }
1934
RTLFUNC(DateSerial)1935 RTLFUNC(DateSerial)
1936 {
1937 (void)pBasic;
1938 (void)bWrite;
1939
1940 if ( rPar.Count() < 4 )
1941 {
1942 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1943 return;
1944 }
1945 sal_Int16 nYear = rPar.Get(1)->GetInteger();
1946 sal_Int16 nMonth = rPar.Get(2)->GetInteger();
1947 sal_Int16 nDay = rPar.Get(3)->GetInteger();
1948
1949 double dDate;
1950 if( implDateSerial( nYear, nMonth, nDay, dDate ) )
1951 rPar.Get(0)->PutDate( dDate );
1952 }
1953
RTLFUNC(TimeSerial)1954 RTLFUNC(TimeSerial)
1955 {
1956 (void)pBasic;
1957 (void)bWrite;
1958
1959 if ( rPar.Count() < 4 )
1960 {
1961 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1962 return;
1963 }
1964 sal_Int16 nHour = rPar.Get(1)->GetInteger();
1965 if ( nHour == 24 )
1966 nHour = 0; // Wegen UNO DateTimes, die bis 24 Uhr gehen
1967 sal_Int16 nMinute = rPar.Get(2)->GetInteger();
1968 sal_Int16 nSecond = rPar.Get(3)->GetInteger();
1969 if ((nHour < 0 || nHour > 23) ||
1970 (nMinute < 0 || nMinute > 59 ) ||
1971 (nSecond < 0 || nSecond > 59 ))
1972 {
1973 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1974 return;
1975 }
1976
1977 sal_Int32 nSeconds = nHour;
1978 nSeconds *= 3600;
1979 nSeconds += nMinute * 60;
1980 nSeconds += nSecond;
1981 double nDays = ((double)nSeconds) / (double)(86400.0);
1982 rPar.Get(0)->PutDate( nDays ); // JSM
1983 }
1984
RTLFUNC(DateValue)1985 RTLFUNC(DateValue)
1986 {
1987 (void)pBasic;
1988 (void)bWrite;
1989
1990 if ( rPar.Count() < 2 )
1991 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1992 else
1993 {
1994 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
1995 SvNumberFormatter* pFormatter = NULL;
1996 if( pINST )
1997 pFormatter = pINST->GetNumberFormatter();
1998 else
1999 {
2000 sal_uInt32 n; // Dummy
2001 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n );
2002 }
2003
2004 sal_uInt32 nIndex = 0;
2005 double fResult;
2006 String aStr( rPar.Get(1)->GetString() );
2007 sal_Bool bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, fResult );
2008 short nType = pFormatter->GetType( nIndex );
2009
2010 // DateValue("February 12, 1969") raises error if the system locale is not en_US
2011 // by using SbiInstance::GetNumberFormatter.
2012 // It seems that both locale number formatter and English number formatter
2013 // are supported in Visual Basic.
2014 LanguageType eLangType = GetpApp()->GetSettings().GetLanguage();
2015 if( !bSuccess && ( eLangType != LANGUAGE_ENGLISH_US ) )
2016 {
2017 // Create a new SvNumberFormatter by using LANGUAGE_ENGLISH to get the date value;
2018 com::sun::star::uno::Reference< com::sun::star::lang::XMultiServiceFactory >
2019 xFactory = comphelper::getProcessServiceFactory();
2020 SvNumberFormatter aFormatter( xFactory, LANGUAGE_ENGLISH_US );
2021 bSuccess = aFormatter.IsNumberFormat( aStr, nIndex, fResult );
2022 nType = aFormatter.GetType( nIndex );
2023 }
2024
2025 if(bSuccess && (nType==NUMBERFORMAT_DATE || nType==NUMBERFORMAT_DATETIME))
2026 {
2027 if ( nType == NUMBERFORMAT_DATETIME )
2028 {
2029 // Zeit abschneiden
2030 if ( fResult > 0.0 )
2031 fResult = floor( fResult );
2032 else
2033 fResult = ceil( fResult );
2034 }
2035 // fResult += 2.0; // Anpassung StarCalcFormatter
2036 rPar.Get(0)->PutDate( fResult ); // JSM
2037 }
2038 else
2039 StarBASIC::Error( SbERR_CONVERSION );
2040
2041 // #39629 pFormatter kann selbst angefordert sein
2042 if( !pINST )
2043 delete pFormatter;
2044 }
2045 }
2046
RTLFUNC(TimeValue)2047 RTLFUNC(TimeValue)
2048 {
2049 (void)pBasic;
2050 (void)bWrite;
2051
2052 if ( rPar.Count() < 2 )
2053 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2054 else
2055 {
2056 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
2057 SvNumberFormatter* pFormatter = NULL;
2058 if( pINST )
2059 pFormatter = pINST->GetNumberFormatter();
2060 else
2061 {
2062 sal_uInt32 n; // Dummy
2063 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n );
2064 }
2065
2066 sal_uInt32 nIndex = 0;
2067 double fResult;
2068 sal_Bool bSuccess = pFormatter->IsNumberFormat( rPar.Get(1)->GetString(),
2069 nIndex, fResult );
2070 short nType = pFormatter->GetType(nIndex);
2071 if(bSuccess && (nType==NUMBERFORMAT_TIME||nType==NUMBERFORMAT_DATETIME))
2072 {
2073 if ( nType == NUMBERFORMAT_DATETIME )
2074 // Tage abschneiden
2075 fResult = fmod( fResult, 1 );
2076 rPar.Get(0)->PutDate( fResult ); // JSM
2077 }
2078 else
2079 StarBASIC::Error( SbERR_CONVERSION );
2080
2081 // #39629 pFormatter kann selbst angefordert sein
2082 if( !pINST )
2083 delete pFormatter;
2084 }
2085 }
2086
RTLFUNC(Day)2087 RTLFUNC(Day)
2088 {
2089 (void)pBasic;
2090 (void)bWrite;
2091
2092 if ( rPar.Count() < 2 )
2093 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2094 else
2095 {
2096 SbxVariableRef pArg = rPar.Get( 1 );
2097 double aDate = pArg->GetDate();
2098
2099 sal_Int16 nDay = implGetDateDay( aDate );
2100 rPar.Get(0)->PutInteger( nDay );
2101 }
2102 }
2103
RTLFUNC(Year)2104 RTLFUNC(Year)
2105 {
2106 (void)pBasic;
2107 (void)bWrite;
2108
2109 if ( rPar.Count() < 2 )
2110 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2111 else
2112 {
2113 sal_Int16 nYear = implGetDateYear( rPar.Get(1)->GetDate() );
2114 rPar.Get(0)->PutInteger( nYear );
2115 }
2116 }
2117
implGetHour(double dDate)2118 sal_Int16 implGetHour( double dDate )
2119 {
2120 double nFrac = dDate - floor( dDate );
2121 nFrac *= 86400.0;
2122 sal_Int32 nSeconds = (sal_Int32)(nFrac + 0.5);
2123 sal_Int16 nHour = (sal_Int16)(nSeconds / 3600);
2124 return nHour;
2125 }
2126
RTLFUNC(Hour)2127 RTLFUNC(Hour)
2128 {
2129 (void)pBasic;
2130 (void)bWrite;
2131
2132 if ( rPar.Count() < 2 )
2133 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2134 else
2135 {
2136 double nArg = rPar.Get(1)->GetDate();
2137 sal_Int16 nHour = implGetHour( nArg );
2138 rPar.Get(0)->PutInteger( nHour );
2139 }
2140 }
2141
implGetMinute(double dDate)2142 sal_Int16 implGetMinute( double dDate )
2143 {
2144 double nFrac = dDate - floor( dDate );
2145 nFrac *= 86400.0;
2146 sal_Int32 nSeconds = (sal_Int32)(nFrac + 0.5);
2147 sal_Int16 nTemp = (sal_Int16)(nSeconds % 3600);
2148 sal_Int16 nMin = nTemp / 60;
2149 return nMin;
2150 }
2151
RTLFUNC(Minute)2152 RTLFUNC(Minute)
2153 {
2154 (void)pBasic;
2155 (void)bWrite;
2156
2157 if ( rPar.Count() < 2 )
2158 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2159 else
2160 {
2161 double nArg = rPar.Get(1)->GetDate();
2162 sal_Int16 nMin = implGetMinute( nArg );
2163 rPar.Get(0)->PutInteger( nMin );
2164 }
2165 }
2166
RTLFUNC(Month)2167 RTLFUNC(Month)
2168 {
2169 (void)pBasic;
2170 (void)bWrite;
2171
2172 if ( rPar.Count() < 2 )
2173 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2174 else
2175 {
2176 sal_Int16 nMonth = implGetDateMonth( rPar.Get(1)->GetDate() );
2177 rPar.Get(0)->PutInteger( nMonth );
2178 }
2179 }
2180
implGetSecond(double dDate)2181 sal_Int16 implGetSecond( double dDate )
2182 {
2183 double nFrac = dDate - floor( dDate );
2184 nFrac *= 86400.0;
2185 sal_Int32 nSeconds = (sal_Int32)(nFrac + 0.5);
2186 sal_Int16 nTemp = (sal_Int16)(nSeconds / 3600);
2187 nSeconds -= nTemp * 3600;
2188 nTemp = (sal_Int16)(nSeconds / 60);
2189 nSeconds -= nTemp * 60;
2190
2191 sal_Int16 nRet = (sal_Int16)nSeconds;
2192 return nRet;
2193 }
2194
RTLFUNC(Second)2195 RTLFUNC(Second)
2196 {
2197 (void)pBasic;
2198 (void)bWrite;
2199
2200 if ( rPar.Count() < 2 )
2201 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2202 else
2203 {
2204 double nArg = rPar.Get(1)->GetDate();
2205 sal_Int16 nSecond = implGetSecond( nArg );
2206 rPar.Get(0)->PutInteger( nSecond );
2207 }
2208 }
2209
Now_Impl()2210 double Now_Impl()
2211 {
2212 Date aDate;
2213 Time aTime;
2214 double aSerial = (double)GetDayDiff( aDate );
2215 long nSeconds = aTime.GetHour();
2216 nSeconds *= 3600;
2217 nSeconds += aTime.GetMin() * 60;
2218 nSeconds += aTime.GetSec();
2219 double nDays = ((double)nSeconds) / (double)(24.0*3600.0);
2220 aSerial += nDays;
2221 return aSerial;
2222 }
2223
2224 // Date Now(void)
2225
RTLFUNC(Now)2226 RTLFUNC(Now)
2227 {
2228 (void)pBasic;
2229 (void)bWrite;
2230 rPar.Get(0)->PutDate( Now_Impl() );
2231 }
2232
2233 // Date Time(void)
2234
RTLFUNC(Time)2235 RTLFUNC(Time)
2236 {
2237 (void)pBasic;
2238
2239 if ( !bWrite )
2240 {
2241 Time aTime;
2242 SbxVariable* pMeth = rPar.Get( 0 );
2243 String aRes;
2244 if( pMeth->IsFixed() )
2245 {
2246 // Time$: hh:mm:ss
2247 char buf[ 20 ];
2248 snprintf( buf, sizeof(buf), "%02d:%02d:%02d",
2249 aTime.GetHour(), aTime.GetMin(), aTime.GetSec() );
2250 aRes = String::CreateFromAscii( buf );
2251 }
2252 else
2253 {
2254 // Time: system dependent
2255 long nSeconds=aTime.GetHour();
2256 nSeconds *= 3600;
2257 nSeconds += aTime.GetMin() * 60;
2258 nSeconds += aTime.GetSec();
2259 double nDays = (double)nSeconds * ( 1.0 / (24.0*3600.0) );
2260 Color* pCol;
2261
2262 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
2263 SvNumberFormatter* pFormatter = NULL;
2264 sal_uInt32 nIndex;
2265 if( pINST )
2266 {
2267 pFormatter = pINST->GetNumberFormatter();
2268 nIndex = pINST->GetStdTimeIdx();
2269 }
2270 else
2271 {
2272 sal_uInt32 n; // Dummy
2273 SbiInstance::PrepareNumberFormatter( pFormatter, n, nIndex, n );
2274 }
2275
2276 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2277
2278 // #39629 pFormatter kann selbst angefordert sein
2279 if( !pINST )
2280 delete pFormatter;
2281 }
2282 pMeth->PutString( aRes );
2283 }
2284 else
2285 {
2286 StarBASIC::Error( SbERR_NOT_IMPLEMENTED );
2287 }
2288 }
2289
RTLFUNC(Timer)2290 RTLFUNC(Timer)
2291 {
2292 (void)pBasic;
2293 (void)bWrite;
2294
2295 Time aTime;
2296 long nSeconds = aTime.GetHour();
2297 nSeconds *= 3600;
2298 nSeconds += aTime.GetMin() * 60;
2299 nSeconds += aTime.GetSec();
2300 rPar.Get(0)->PutDate( (double)nSeconds );
2301 }
2302
2303
RTLFUNC(Date)2304 RTLFUNC(Date)
2305 {
2306 (void)pBasic;
2307 (void)bWrite;
2308
2309 if ( !bWrite )
2310 {
2311 Date aToday;
2312 double nDays = (double)GetDayDiff( aToday );
2313 SbxVariable* pMeth = rPar.Get( 0 );
2314 if( pMeth->IsString() )
2315 {
2316 String aRes;
2317 Color* pCol;
2318
2319 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
2320 SvNumberFormatter* pFormatter = NULL;
2321 sal_uInt32 nIndex;
2322 if( pINST )
2323 {
2324 pFormatter = pINST->GetNumberFormatter();
2325 nIndex = pINST->GetStdDateIdx();
2326 }
2327 else
2328 {
2329 sal_uInt32 n; // Dummy
2330 SbiInstance::PrepareNumberFormatter( pFormatter, nIndex, n, n );
2331 }
2332
2333 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2334 pMeth->PutString( aRes );
2335
2336 // #39629 pFormatter kann selbst angefordert sein
2337 if( !pINST )
2338 delete pFormatter;
2339 }
2340 else
2341 pMeth->PutDate( nDays );
2342 }
2343 else
2344 {
2345 StarBASIC::Error( SbERR_NOT_IMPLEMENTED );
2346 }
2347 }
2348
RTLFUNC(IsArray)2349 RTLFUNC(IsArray)
2350 {
2351 (void)pBasic;
2352 (void)bWrite;
2353
2354 if ( rPar.Count() < 2 )
2355 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2356 else
2357 rPar.Get(0)->PutBool((rPar.Get(1)->GetType() & SbxARRAY) ? sal_True : sal_False );
2358 }
2359
RTLFUNC(IsObject)2360 RTLFUNC(IsObject)
2361 {
2362 (void)pBasic;
2363 (void)bWrite;
2364
2365 if ( rPar.Count() < 2 )
2366 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2367 else
2368 {
2369 SbxVariable* pVar = rPar.Get(1);
2370 SbxBase* pObj = (SbxBase*)pVar->GetObject();
2371
2372 // #100385: GetObject can result in an error, so reset it
2373 SbxBase::ResetError();
2374
2375 SbUnoClass* pUnoClass;
2376 sal_Bool bObject;
2377 if( pObj && NULL != ( pUnoClass=PTR_CAST(SbUnoClass,pObj) ) )
2378 {
2379 bObject = pUnoClass->getUnoClass().is();
2380 }
2381 else
2382 {
2383 bObject = pVar->IsObject();
2384 }
2385 rPar.Get( 0 )->PutBool( bObject );
2386 }
2387 }
2388
RTLFUNC(IsDate)2389 RTLFUNC(IsDate)
2390 {
2391 (void)pBasic;
2392 (void)bWrite;
2393
2394 if ( rPar.Count() < 2 )
2395 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2396 else
2397 {
2398 // #46134 Nur String wird konvertiert, andere Typen ergeben sal_False
2399 SbxVariableRef xArg = rPar.Get( 1 );
2400 SbxDataType eType = xArg->GetType();
2401 sal_Bool bDate = sal_False;
2402
2403 if( eType == SbxDATE )
2404 {
2405 bDate = sal_True;
2406 }
2407 else if( eType == SbxSTRING )
2408 {
2409 // Error loeschen
2410 SbxError nPrevError = SbxBase::GetError();
2411 SbxBase::ResetError();
2412
2413 // Konvertierung des Parameters nach SbxDATE erzwingen
2414 xArg->SbxValue::GetDate();
2415
2416 // Bei Fehler ist es kein Date
2417 bDate = !SbxBase::IsError();
2418
2419 // Error-Situation wiederherstellen
2420 SbxBase::ResetError();
2421 SbxBase::SetError( nPrevError );
2422 }
2423 rPar.Get( 0 )->PutBool( bDate );
2424 }
2425 }
2426
RTLFUNC(IsEmpty)2427 RTLFUNC(IsEmpty)
2428 {
2429 (void)pBasic;
2430 (void)bWrite;
2431
2432 if ( rPar.Count() < 2 )
2433 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2434 else
2435 rPar.Get( 0 )->PutBool( rPar.Get(1)->IsEmpty() );
2436 }
2437
RTLFUNC(IsError)2438 RTLFUNC(IsError)
2439 {
2440 (void)pBasic;
2441 (void)bWrite;
2442
2443 if ( rPar.Count() < 2 )
2444 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2445 else
2446 rPar.Get( 0 )->PutBool( rPar.Get(1)->IsErr() );
2447 }
2448
RTLFUNC(IsNull)2449 RTLFUNC(IsNull)
2450 {
2451 (void)pBasic;
2452 (void)bWrite;
2453
2454 if ( rPar.Count() < 2 )
2455 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2456 else
2457 {
2458 // #51475 Wegen Uno-Objekten auch true liefern,
2459 // wenn der pObj-Wert NULL ist
2460 SbxVariableRef pArg = rPar.Get( 1 );
2461 sal_Bool bNull = rPar.Get(1)->IsNull();
2462 if( !bNull && pArg->GetType() == SbxOBJECT )
2463 {
2464 SbxBase* pObj = pArg->GetObject();
2465 if( !pObj )
2466 bNull = sal_True;
2467 }
2468 rPar.Get( 0 )->PutBool( bNull );
2469 }
2470 }
2471
RTLFUNC(IsNumeric)2472 RTLFUNC(IsNumeric)
2473 {
2474 (void)pBasic;
2475 (void)bWrite;
2476
2477 if ( rPar.Count() < 2 )
2478 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2479 else
2480 rPar.Get( 0 )->PutBool( rPar.Get( 1 )->IsNumericRTL() );
2481 }
2482
2483 // Das machen wir auf die billige Tour
2484
RTLFUNC(IsMissing)2485 RTLFUNC(IsMissing)
2486 {
2487 (void)pBasic;
2488 (void)bWrite;
2489
2490 if ( rPar.Count() < 2 )
2491 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2492 else
2493 // #57915 Missing wird durch Error angezeigt
2494 rPar.Get( 0 )->PutBool( rPar.Get(1)->IsErr() );
2495 }
2496
2497 // Dir( [Maske] [,Attrs] )
2498 // ToDo: Library-globaler Datenbereich fuer Dir-Objekt und Flags
2499
2500
getDirectoryPath(String aPathStr)2501 String getDirectoryPath( String aPathStr )
2502 {
2503 String aRetStr;
2504
2505 DirectoryItem aItem;
2506 FileBase::RC nRet = DirectoryItem::get( aPathStr, aItem );
2507 if( nRet == FileBase::E_None )
2508 {
2509 FileStatus aFileStatus( FileStatusMask_Type );
2510 nRet = aItem.getFileStatus( aFileStatus );
2511 if( nRet == FileBase::E_None )
2512 {
2513 FileStatus::Type aType = aFileStatus.getFileType();
2514 if( isFolder( aType ) )
2515 {
2516 aRetStr = aPathStr;
2517 }
2518 else if( aType == FileStatus::Link )
2519 {
2520 FileStatus aFileStatus2( FileStatusMask_LinkTargetURL );
2521 nRet = aItem.getFileStatus( aFileStatus2 );
2522 if( nRet == FileBase::E_None )
2523 aRetStr = getDirectoryPath( aFileStatus2.getLinkTargetURL() );
2524 }
2525 }
2526 }
2527 return aRetStr;
2528 }
2529
2530 // Function looks for wildcards, removes them and always returns the pure path
implSetupWildcard(const String & rFileParam,SbiRTLData * pRTLData)2531 String implSetupWildcard( const String& rFileParam, SbiRTLData* pRTLData )
2532 {
2533 static String aAsterisk = String::CreateFromAscii( "*" );
2534 static sal_Char cDelim1 = (sal_Char)'/';
2535 static sal_Char cDelim2 = (sal_Char)'\\';
2536 static sal_Char cWild1 = '*';
2537 static sal_Char cWild2 = '?';
2538
2539 delete pRTLData->pWildCard;
2540 pRTLData->pWildCard = NULL;
2541 pRTLData->sFullNameToBeChecked = String();
2542
2543 String aFileParam = rFileParam;
2544 xub_StrLen nLastWild = aFileParam.SearchBackward( cWild1 );
2545 if( nLastWild == STRING_NOTFOUND )
2546 nLastWild = aFileParam.SearchBackward( cWild2 );
2547 sal_Bool bHasWildcards = ( nLastWild != STRING_NOTFOUND );
2548
2549
2550 xub_StrLen nLastDelim = aFileParam.SearchBackward( cDelim1 );
2551 if( nLastDelim == STRING_NOTFOUND )
2552 nLastDelim = aFileParam.SearchBackward( cDelim2 );
2553
2554 if( bHasWildcards )
2555 {
2556 // Wildcards in path?
2557 if( nLastDelim != STRING_NOTFOUND && nLastDelim > nLastWild )
2558 return aFileParam;
2559 }
2560 else
2561 {
2562 String aPathStr = getFullPath( aFileParam );
2563 if( nLastDelim != aFileParam.Len() - 1 )
2564 pRTLData->sFullNameToBeChecked = aPathStr;
2565 return aPathStr;
2566 }
2567
2568 String aPureFileName;
2569 if( nLastDelim == STRING_NOTFOUND )
2570 {
2571 aPureFileName = aFileParam;
2572 aFileParam = String();
2573 }
2574 else
2575 {
2576 aPureFileName = aFileParam.Copy( nLastDelim + 1 );
2577 aFileParam = aFileParam.Copy( 0, nLastDelim );
2578 }
2579
2580 // Try again to get a valid URL/UNC-path with only the path
2581 String aPathStr = getFullPath( aFileParam );
2582 xub_StrLen nPureLen = aPureFileName.Len();
2583
2584 // Is there a pure file name left? Otherwise the path is
2585 // invalid anyway because it was not accepted by OSL before
2586 if( nPureLen && aPureFileName != aAsterisk )
2587 {
2588 pRTLData->pWildCard = new WildCard( aPureFileName );
2589 }
2590 return aPathStr;
2591 }
2592
implCheckWildcard(const String & rName,SbiRTLData * pRTLData)2593 inline sal_Bool implCheckWildcard( const String& rName, SbiRTLData* pRTLData )
2594 {
2595 sal_Bool bMatch = sal_True;
2596
2597 if( pRTLData->pWildCard )
2598 bMatch = pRTLData->pWildCard->Matches( rName );
2599 return bMatch;
2600 }
2601
2602
isRootDir(String aDirURLStr)2603 bool isRootDir( String aDirURLStr )
2604 {
2605 INetURLObject aDirURLObj( aDirURLStr );
2606 sal_Bool bRoot = sal_False;
2607
2608 // Check if it's a root directory
2609 sal_Int32 nCount = aDirURLObj.getSegmentCount();
2610
2611 // No segment means Unix root directory "file:///"
2612 if( nCount == 0 )
2613 {
2614 bRoot = sal_True;
2615 }
2616 // Exactly one segment needs further checking, because it
2617 // can be Unix "file:///foo/" -> no root
2618 // or Windows "file:///c:/" -> root
2619 else if( nCount == 1 )
2620 {
2621 ::rtl::OUString aSeg1 = aDirURLObj.getName( 0, sal_True,
2622 INetURLObject::DECODE_WITH_CHARSET );
2623 if( aSeg1.getStr()[1] == (sal_Unicode)':' )
2624 {
2625 bRoot = sal_True;
2626 }
2627 }
2628 // More than one segments can never be root
2629 // so bRoot remains sal_False
2630
2631 return bRoot;
2632 }
2633
RTLFUNC(Dir)2634 RTLFUNC(Dir)
2635 {
2636 (void)pBasic;
2637 (void)bWrite;
2638
2639 String aPath;
2640
2641 sal_uInt16 nParCount = rPar.Count();
2642 if( nParCount > 3 )
2643 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2644 else
2645 {
2646 SbiRTLData* pRTLData = pINST->GetRTLData();
2647
2648 // #34645: Kann auch von der URL-Zeile ueber 'macro: Dir' aufgerufen werden
2649 // dann existiert kein pRTLData und die Methode muss verlassen werden
2650 if( !pRTLData )
2651 return;
2652
2653 // <-- UCB
2654 if( hasUno() )
2655 {
2656 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
2657 if( xSFI.is() )
2658 {
2659 if ( nParCount >= 2 )
2660 {
2661 String aFileParam = rPar.Get(1)->GetString();
2662
2663 String aFileURLStr = implSetupWildcard( aFileParam, pRTLData );
2664 if( pRTLData->sFullNameToBeChecked.Len() > 0 )
2665 {
2666 sal_Bool bExists = sal_False;
2667 try { bExists = xSFI->exists( aFileURLStr ); }
2668 catch( Exception & ) {}
2669
2670 String aNameOnlyStr;
2671 if( bExists )
2672 {
2673 INetURLObject aFileURL( aFileURLStr );
2674 aNameOnlyStr = aFileURL.getName( INetURLObject::LAST_SEGMENT,
2675 true, INetURLObject::DECODE_WITH_CHARSET );
2676 }
2677 rPar.Get(0)->PutString( aNameOnlyStr );
2678 return;
2679 }
2680
2681 try
2682 {
2683 String aDirURLStr;
2684 sal_Bool bFolder = xSFI->isFolder( aFileURLStr );
2685
2686 if( bFolder )
2687 {
2688 aDirURLStr = aFileURLStr;
2689 }
2690 else
2691 {
2692 String aEmptyStr;
2693 rPar.Get(0)->PutString( aEmptyStr );
2694 }
2695
2696 sal_uInt16 nFlags = 0;
2697 if ( nParCount > 2 )
2698 pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger();
2699 else
2700 pRTLData->nDirFlags = 0;
2701
2702 // Read directory
2703 sal_Bool bIncludeFolders = ((nFlags & Sb_ATTR_DIRECTORY) != 0);
2704 pRTLData->aDirSeq = xSFI->getFolderContents( aDirURLStr, bIncludeFolders );
2705 pRTLData->nCurDirPos = 0;
2706
2707 // #78651 Add "." and ".." directories for VB compatibility
2708 if( bIncludeFolders )
2709 {
2710 sal_Bool bRoot = isRootDir( aDirURLStr );
2711
2712 // If it's no root directory we flag the need for
2713 // the "." and ".." directories by the value -2
2714 // for the actual position. Later for -2 will be
2715 // returned "." and for -1 ".."
2716 if( !bRoot )
2717 {
2718 pRTLData->nCurDirPos = -2;
2719 }
2720 }
2721 }
2722 catch( Exception & )
2723 {
2724 //StarBASIC::Error( ERRCODE_IO_GENERAL );
2725 }
2726 }
2727
2728
2729 if( pRTLData->aDirSeq.getLength() > 0 )
2730 {
2731 sal_Bool bFolderFlag = ((pRTLData->nDirFlags & Sb_ATTR_DIRECTORY) != 0);
2732
2733 SbiInstance* pInst = pINST;
2734 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
2735 for( ;; )
2736 {
2737 if( pRTLData->nCurDirPos < 0 )
2738 {
2739 if( pRTLData->nCurDirPos == -2 )
2740 {
2741 aPath = ::rtl::OUString::createFromAscii( "." );
2742 }
2743 else if( pRTLData->nCurDirPos == -1 )
2744 {
2745 aPath = ::rtl::OUString::createFromAscii( ".." );
2746 }
2747 pRTLData->nCurDirPos++;
2748 }
2749 else if( pRTLData->nCurDirPos >= pRTLData->aDirSeq.getLength() )
2750 {
2751 pRTLData->aDirSeq.realloc( 0 );
2752 aPath.Erase();
2753 break;
2754 }
2755 else
2756 {
2757 ::rtl::OUString aFile = pRTLData->aDirSeq.getConstArray()[pRTLData->nCurDirPos++];
2758
2759 if( bCompatibility )
2760 {
2761 if( !bFolderFlag )
2762 {
2763 sal_Bool bFolder = xSFI->isFolder( aFile );
2764 if( bFolder )
2765 continue;
2766 }
2767 }
2768 else
2769 {
2770 // Only directories
2771 if( bFolderFlag )
2772 {
2773 sal_Bool bFolder = xSFI->isFolder( aFile );
2774 if( !bFolder )
2775 continue;
2776 }
2777 }
2778
2779 INetURLObject aURL( aFile );
2780 aPath = aURL.getName( INetURLObject::LAST_SEGMENT, sal_True,
2781 INetURLObject::DECODE_WITH_CHARSET );
2782 }
2783
2784 sal_Bool bMatch = implCheckWildcard( aPath, pRTLData );
2785 if( !bMatch )
2786 continue;
2787
2788 break;
2789 }
2790 }
2791 rPar.Get(0)->PutString( aPath );
2792 }
2793 }
2794 else
2795 // --> UCB
2796 {
2797 #ifdef _OLD_FILE_IMPL
2798 if ( nParCount >= 2 )
2799 {
2800 delete pRTLData->pDir;
2801 pRTLData->pDir = 0; // wg. Sonderbehandlung Sb_ATTR_VOLUME
2802 DirEntry aEntry( rPar.Get(1)->GetString() );
2803 FileStat aStat( aEntry );
2804 if(!aStat.GetError() && (aStat.GetKind() & FSYS_KIND_FILE))
2805 {
2806 // ah ja, ist nur ein dateiname
2807 // Pfad abschneiden (wg. VB4)
2808 rPar.Get(0)->PutString( aEntry.GetName() );
2809 return;
2810 }
2811 sal_uInt16 nFlags = 0;
2812 if ( nParCount > 2 )
2813 pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger();
2814 else
2815 pRTLData->nDirFlags = 0;
2816
2817 // Sb_ATTR_VOLUME wird getrennt gehandelt
2818 if( pRTLData->nDirFlags & Sb_ATTR_VOLUME )
2819 aPath = aEntry.GetVolume();
2820 else
2821 {
2822 // Die richtige Auswahl treffen
2823 sal_uInt16 nMode = FSYS_KIND_FILE;
2824 if( nFlags & Sb_ATTR_DIRECTORY )
2825 nMode |= FSYS_KIND_DIR;
2826 if( nFlags == Sb_ATTR_DIRECTORY )
2827 nMode = FSYS_KIND_DIR;
2828 pRTLData->pDir = new Dir( aEntry, (DirEntryKind) nMode );
2829 pRTLData->nCurDirPos = 0;
2830 }
2831 }
2832
2833 if( pRTLData->pDir )
2834 {
2835 for( ;; )
2836 {
2837 if( pRTLData->nCurDirPos >= pRTLData->pDir->Count() )
2838 {
2839 delete pRTLData->pDir;
2840 pRTLData->pDir = 0;
2841 aPath.Erase();
2842 break;
2843 }
2844 DirEntry aNextEntry=(*(pRTLData->pDir))[pRTLData->nCurDirPos++];
2845 aPath = aNextEntry.GetName(); //Full();
2846 break;
2847 }
2848 }
2849 rPar.Get(0)->PutString( aPath );
2850 #else
2851 // TODO: OSL
2852 if ( nParCount >= 2 )
2853 {
2854 String aFileParam = rPar.Get(1)->GetString();
2855
2856 String aDirURL = implSetupWildcard( aFileParam, pRTLData );
2857
2858 sal_uInt16 nFlags = 0;
2859 if ( nParCount > 2 )
2860 pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger();
2861 else
2862 pRTLData->nDirFlags = 0;
2863
2864 // Read directory
2865 sal_Bool bIncludeFolders = ((nFlags & Sb_ATTR_DIRECTORY) != 0);
2866 pRTLData->pDir = new Directory( aDirURL );
2867 FileBase::RC nRet = pRTLData->pDir->open();
2868 if( nRet != FileBase::E_None )
2869 {
2870 delete pRTLData->pDir;
2871 pRTLData->pDir = NULL;
2872 rPar.Get(0)->PutString( String() );
2873 return;
2874 }
2875
2876 // #86950 Add "." and ".." directories for VB compatibility
2877 pRTLData->nCurDirPos = 0;
2878 if( bIncludeFolders )
2879 {
2880 sal_Bool bRoot = isRootDir( aDirURL );
2881
2882 // If it's no root directory we flag the need for
2883 // the "." and ".." directories by the value -2
2884 // for the actual position. Later for -2 will be
2885 // returned "." and for -1 ".."
2886 if( !bRoot )
2887 {
2888 pRTLData->nCurDirPos = -2;
2889 }
2890 }
2891
2892 }
2893
2894 if( pRTLData->pDir )
2895 {
2896 sal_Bool bFolderFlag = ((pRTLData->nDirFlags & Sb_ATTR_DIRECTORY) != 0);
2897 for( ;; )
2898 {
2899 if( pRTLData->nCurDirPos < 0 )
2900 {
2901 if( pRTLData->nCurDirPos == -2 )
2902 {
2903 aPath = ::rtl::OUString::createFromAscii( "." );
2904 }
2905 else if( pRTLData->nCurDirPos == -1 )
2906 {
2907 aPath = ::rtl::OUString::createFromAscii( ".." );
2908 }
2909 pRTLData->nCurDirPos++;
2910 }
2911 else
2912 {
2913 DirectoryItem aItem;
2914 FileBase::RC nRet = pRTLData->pDir->getNextItem( aItem );
2915 if( nRet != FileBase::E_None )
2916 {
2917 delete pRTLData->pDir;
2918 pRTLData->pDir = NULL;
2919 aPath.Erase();
2920 break;
2921 }
2922
2923 // Handle flags
2924 FileStatus aFileStatus( FileStatusMask_Type | FileStatusMask_FileName );
2925 nRet = aItem.getFileStatus( aFileStatus );
2926
2927 // Only directories?
2928 if( bFolderFlag )
2929 {
2930 FileStatus::Type aType = aFileStatus.getFileType();
2931 sal_Bool bFolder = isFolder( aType );
2932 if( !bFolder )
2933 continue;
2934 }
2935
2936 aPath = aFileStatus.getFileName();
2937 }
2938
2939 sal_Bool bMatch = implCheckWildcard( aPath, pRTLData );
2940 if( !bMatch )
2941 continue;
2942
2943 break;
2944 }
2945 }
2946 rPar.Get(0)->PutString( aPath );
2947 #endif
2948 }
2949 }
2950 }
2951
2952
RTLFUNC(GetAttr)2953 RTLFUNC(GetAttr)
2954 {
2955 (void)pBasic;
2956 (void)bWrite;
2957
2958 if ( rPar.Count() == 2 )
2959 {
2960 sal_Int16 nFlags = 0;
2961
2962 // In Windows, We want to use Windows API to get the file attributes
2963 // for VBA interoperability.
2964 #if defined( WNT )
2965 if( SbiRuntime::isVBAEnabled() )
2966 {
2967 DirEntry aEntry( rPar.Get(1)->GetString() );
2968 aEntry.ToAbs();
2969
2970 // #57064 Bei virtuellen URLs den Real-Path extrahieren
2971 ByteString aByteStrFullPath( aEntry.GetFull(), gsl_getSystemTextEncoding() );
2972 DWORD nRealFlags = GetFileAttributes (aByteStrFullPath.GetBuffer());
2973 if (nRealFlags != 0xffffffff)
2974 {
2975 if (nRealFlags == FILE_ATTRIBUTE_NORMAL)
2976 nRealFlags = 0;
2977 nFlags = (sal_Int16) (nRealFlags);
2978 }
2979 else
2980 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
2981
2982 rPar.Get(0)->PutInteger( nFlags );
2983
2984 return;
2985 }
2986 #endif
2987
2988 // <-- UCB
2989 if( hasUno() )
2990 {
2991 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
2992 if( xSFI.is() )
2993 {
2994 try
2995 {
2996 String aPath = getFullPath( rPar.Get(1)->GetString() );
2997 sal_Bool bExists = sal_False;
2998 try { bExists = xSFI->exists( aPath ); }
2999 catch( Exception & ) {}
3000 if( !bExists )
3001 {
3002 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
3003 return;
3004 }
3005
3006 sal_Bool bReadOnly = xSFI->isReadOnly( aPath );
3007 sal_Bool bHidden = xSFI->isHidden( aPath );
3008 sal_Bool bDirectory = xSFI->isFolder( aPath );
3009 if( bReadOnly )
3010 nFlags |= 0x0001; // ATTR_READONLY
3011 if( bHidden )
3012 nFlags |= 0x0002; // ATTR_HIDDEN
3013 if( bDirectory )
3014 nFlags |= 0x0010; // ATTR_DIRECTORY
3015 }
3016 catch( Exception & )
3017 {
3018 StarBASIC::Error( ERRCODE_IO_GENERAL );
3019 }
3020 }
3021 }
3022 else
3023 // --> UCB
3024 {
3025 DirectoryItem aItem;
3026 FileBase::RC nRet = DirectoryItem::get( getFullPathUNC( rPar.Get(1)->GetString() ), aItem );
3027 FileStatus aFileStatus( FileStatusMask_Attributes | FileStatusMask_Type );
3028 nRet = aItem.getFileStatus( aFileStatus );
3029 sal_uInt64 nAttributes = aFileStatus.getAttributes();
3030 sal_Bool bReadOnly = (nAttributes & Attribute_ReadOnly) != 0;
3031
3032 FileStatus::Type aType = aFileStatus.getFileType();
3033 sal_Bool bDirectory = isFolder( aType );
3034 if( bReadOnly )
3035 nFlags |= 0x0001; // ATTR_READONLY
3036 if( bDirectory )
3037 nFlags |= 0x0010; // ATTR_DIRECTORY
3038 }
3039 rPar.Get(0)->PutInteger( nFlags );
3040 }
3041 else
3042 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3043 }
3044
3045
RTLFUNC(FileDateTime)3046 RTLFUNC(FileDateTime)
3047 {
3048 (void)pBasic;
3049 (void)bWrite;
3050
3051 if ( rPar.Count() != 2 )
3052 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3053 else
3054 {
3055 // <-- UCB
3056 String aPath = rPar.Get(1)->GetString();
3057 Time aTime;
3058 Date aDate;
3059 if( hasUno() )
3060 {
3061 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
3062 if( xSFI.is() )
3063 {
3064 try
3065 {
3066 com::sun::star::util::DateTime aUnoDT = xSFI->getDateTimeModified( aPath );
3067 aTime = Time( aUnoDT.Hours, aUnoDT.Minutes, aUnoDT.Seconds, aUnoDT.HundredthSeconds );
3068 aDate = Date( aUnoDT.Day, aUnoDT.Month, aUnoDT.Year );
3069 }
3070 catch( Exception & )
3071 {
3072 StarBASIC::Error( ERRCODE_IO_GENERAL );
3073 }
3074 }
3075 }
3076 else
3077 // --> UCB
3078 {
3079 #ifdef _OLD_FILE_IMPL
3080 DirEntry aEntry( aPath );
3081 FileStat aStat( aEntry );
3082 aTime = Time( aStat.TimeModified() );
3083 aDate = Date( aStat.DateModified() );
3084 #else
3085 DirectoryItem aItem;
3086 FileBase::RC nRet = DirectoryItem::get( getFullPathUNC( aPath ), aItem );
3087 FileStatus aFileStatus( FileStatusMask_ModifyTime );
3088 nRet = aItem.getFileStatus( aFileStatus );
3089 TimeValue aTimeVal = aFileStatus.getModifyTime();
3090 oslDateTime aDT;
3091 osl_getDateTimeFromTimeValue( &aTimeVal, &aDT );
3092
3093 aTime = Time( aDT.Hours, aDT.Minutes, aDT.Seconds, 10000000*aDT.NanoSeconds );
3094 aDate = Date( aDT.Day, aDT.Month, aDT.Year );
3095 #endif
3096 }
3097
3098 double fSerial = (double)GetDayDiff( aDate );
3099 long nSeconds = aTime.GetHour();
3100 nSeconds *= 3600;
3101 nSeconds += aTime.GetMin() * 60;
3102 nSeconds += aTime.GetSec();
3103 double nDays = ((double)nSeconds) / (double)(24.0*3600.0);
3104 fSerial += nDays;
3105
3106 Color* pCol;
3107
3108 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
3109 SvNumberFormatter* pFormatter = NULL;
3110 sal_uInt32 nIndex;
3111 if( pINST )
3112 {
3113 pFormatter = pINST->GetNumberFormatter();
3114 nIndex = pINST->GetStdDateTimeIdx();
3115 }
3116 else
3117 {
3118 sal_uInt32 n; // Dummy
3119 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, nIndex );
3120 }
3121
3122 String aRes;
3123 pFormatter->GetOutputString( fSerial, nIndex, aRes, &pCol );
3124 rPar.Get(0)->PutString( aRes );
3125
3126 // #39629 pFormatter kann selbst angefordert sein
3127 if( !pINST )
3128 delete pFormatter;
3129 }
3130 }
3131
3132
RTLFUNC(EOF)3133 RTLFUNC(EOF)
3134 {
3135 (void)pBasic;
3136 (void)bWrite;
3137
3138 // AB 08/16/2000: No changes for UCB
3139 if ( rPar.Count() != 2 )
3140 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3141 else
3142 {
3143 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3144 // nChannel--; // macht MD beim Oeffnen auch nicht
3145 SbiIoSystem* pIO = pINST->GetIoSystem();
3146 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3147 if ( !pSbStrm )
3148 {
3149 StarBASIC::Error( SbERR_BAD_CHANNEL );
3150 return;
3151 }
3152 sal_Bool bIsEof;
3153 SvStream* pSvStrm = pSbStrm->GetStrm();
3154 if ( pSbStrm->IsText() )
3155 {
3156 char cBla;
3157 (*pSvStrm) >> cBla; // koennen wir noch ein Zeichen lesen
3158 bIsEof = pSvStrm->IsEof();
3159 if ( !bIsEof )
3160 pSvStrm->SeekRel( -1 );
3161 }
3162 else
3163 bIsEof = pSvStrm->IsEof(); // fuer binaerdateien!
3164 rPar.Get(0)->PutBool( bIsEof );
3165 }
3166 }
3167
RTLFUNC(FileAttr)3168 RTLFUNC(FileAttr)
3169 {
3170 (void)pBasic;
3171 (void)bWrite;
3172
3173 // AB 08/16/2000: No changes for UCB
3174
3175 // #57064 Obwohl diese Funktion nicht mit DirEntry arbeitet, ist sie von
3176 // der Anpassung an virtuelle URLs nich betroffen, da sie nur auf bereits
3177 // geoeffneten Dateien arbeitet und der Name hier keine Rolle spielt.
3178
3179 if ( rPar.Count() != 3 )
3180 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3181 else
3182 {
3183 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3184 // nChannel--;
3185 SbiIoSystem* pIO = pINST->GetIoSystem();
3186 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3187 if ( !pSbStrm )
3188 {
3189 StarBASIC::Error( SbERR_BAD_CHANNEL );
3190 return;
3191 }
3192 sal_Int16 nRet;
3193 if ( rPar.Get(2)->GetInteger() == 1 )
3194 nRet = (sal_Int16)(pSbStrm->GetMode());
3195 else
3196 nRet = 0; // System file handle not supported
3197
3198 rPar.Get(0)->PutInteger( nRet );
3199 }
3200 }
RTLFUNC(Loc)3201 RTLFUNC(Loc)
3202 {
3203 (void)pBasic;
3204 (void)bWrite;
3205
3206 // AB 08/16/2000: No changes for UCB
3207 if ( rPar.Count() != 2 )
3208 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3209 else
3210 {
3211 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3212 SbiIoSystem* pIO = pINST->GetIoSystem();
3213 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3214 if ( !pSbStrm )
3215 {
3216 StarBASIC::Error( SbERR_BAD_CHANNEL );
3217 return;
3218 }
3219 SvStream* pSvStrm = pSbStrm->GetStrm();
3220 sal_uIntPtr nPos;
3221 if( pSbStrm->IsRandom())
3222 {
3223 short nBlockLen = pSbStrm->GetBlockLen();
3224 nPos = nBlockLen ? (pSvStrm->Tell() / nBlockLen) : 0;
3225 nPos++; // Blockpositionen beginnen bei 1
3226 }
3227 else if ( pSbStrm->IsText() )
3228 nPos = pSbStrm->GetLine();
3229 else if( pSbStrm->IsBinary() )
3230 nPos = pSvStrm->Tell();
3231 else if ( pSbStrm->IsSeq() )
3232 nPos = ( pSvStrm->Tell()+1 ) / 128;
3233 else
3234 nPos = pSvStrm->Tell();
3235 rPar.Get(0)->PutLong( (sal_Int32)nPos );
3236 }
3237 }
3238
RTLFUNC(Lof)3239 RTLFUNC(Lof)
3240 {
3241 (void)pBasic;
3242 (void)bWrite;
3243
3244 // AB 08/16/2000: No changes for UCB
3245 if ( rPar.Count() != 2 )
3246 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3247 else
3248 {
3249 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3250 SbiIoSystem* pIO = pINST->GetIoSystem();
3251 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3252 if ( !pSbStrm )
3253 {
3254 StarBASIC::Error( SbERR_BAD_CHANNEL );
3255 return;
3256 }
3257 SvStream* pSvStrm = pSbStrm->GetStrm();
3258 sal_uIntPtr nOldPos = pSvStrm->Tell();
3259 sal_uIntPtr nLen = pSvStrm->Seek( STREAM_SEEK_TO_END );
3260 pSvStrm->Seek( nOldPos );
3261 rPar.Get(0)->PutLong( (sal_Int32)nLen );
3262 }
3263 }
3264
3265
RTLFUNC(Seek)3266 RTLFUNC(Seek)
3267 {
3268 (void)pBasic;
3269 (void)bWrite;
3270
3271 // AB 08/16/2000: No changes for UCB
3272 int nArgs = (int)rPar.Count();
3273 if ( nArgs < 2 || nArgs > 3 )
3274 {
3275 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3276 return;
3277 }
3278 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3279 // nChannel--;
3280 SbiIoSystem* pIO = pINST->GetIoSystem();
3281 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3282 if ( !pSbStrm )
3283 {
3284 StarBASIC::Error( SbERR_BAD_CHANNEL );
3285 return;
3286 }
3287 SvStream* pStrm = pSbStrm->GetStrm();
3288
3289 if ( nArgs == 2 ) // Seek-Function
3290 {
3291 sal_uIntPtr nPos = pStrm->Tell();
3292 if( pSbStrm->IsRandom() )
3293 nPos = nPos / pSbStrm->GetBlockLen();
3294 nPos++; // Basic zaehlt ab 1
3295 rPar.Get(0)->PutLong( (sal_Int32)nPos );
3296 }
3297 else // Seek-Statement
3298 {
3299 sal_Int32 nPos = rPar.Get(2)->GetLong();
3300 if ( nPos < 1 )
3301 {
3302 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3303 return;
3304 }
3305 nPos--; // Basic zaehlt ab 1, SvStreams zaehlen ab 0
3306 pSbStrm->SetExpandOnWriteTo( 0 );
3307 if ( pSbStrm->IsRandom() )
3308 nPos *= pSbStrm->GetBlockLen();
3309 pStrm->Seek( (sal_uIntPtr)nPos );
3310 pSbStrm->SetExpandOnWriteTo( nPos );
3311 }
3312 }
3313
RTLFUNC(Format)3314 RTLFUNC(Format)
3315 {
3316 (void)pBasic;
3317 (void)bWrite;
3318
3319 sal_uInt16 nArgCount = (sal_uInt16)rPar.Count();
3320 if ( nArgCount < 2 || nArgCount > 3 )
3321 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3322 else
3323 {
3324 String aResult;
3325 if( nArgCount == 2 )
3326 rPar.Get(1)->Format( aResult );
3327 else
3328 {
3329 String aFmt( rPar.Get(2)->GetString() );
3330 rPar.Get(1)->Format( aResult, &aFmt );
3331 }
3332 rPar.Get(0)->PutString( aResult );
3333 }
3334 }
3335
RTLFUNC(Randomize)3336 RTLFUNC(Randomize)
3337 {
3338 (void)pBasic;
3339 (void)bWrite;
3340
3341 if ( rPar.Count() > 2 )
3342 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3343 sal_Int16 nSeed;
3344 if( rPar.Count() == 2 )
3345 nSeed = (sal_Int16)rPar.Get(1)->GetInteger();
3346 else
3347 nSeed = (sal_Int16)rand();
3348 srand( nSeed );
3349 }
3350
RTLFUNC(Rnd)3351 RTLFUNC(Rnd)
3352 {
3353 (void)pBasic;
3354 (void)bWrite;
3355
3356 if ( rPar.Count() > 2 )
3357 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3358 else
3359 {
3360 double nRand = (double)rand();
3361 nRand = ( nRand / (double)RAND_MAX );
3362 rPar.Get(0)->PutDouble( nRand );
3363 }
3364 }
3365
3366
3367 //
3368 // Syntax: Shell("Path",[ Window-Style,[ "Params", [ bSync = sal_False ]]])
3369 //
3370 // WindowStyles (VBA-kompatibel):
3371 // 2 == Minimized
3372 // 3 == Maximized
3373 // 10 == Full-Screen (Textmodus-Anwendungen OS/2, WIN95, WNT)
3374 //
3375 // !!!HACK der WindowStyle wird im Creator an Application::StartApp
3376 // uebergeben. Format: "xxxx2"
3377 //
3378
3379
RTLFUNC(Shell)3380 RTLFUNC(Shell)
3381 {
3382 (void)pBasic;
3383 (void)bWrite;
3384
3385 // No shell command for "virtual" portal users
3386 if( needSecurityRestrictions() )
3387 {
3388 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3389 return;
3390 }
3391
3392 sal_uIntPtr nArgCount = rPar.Count();
3393 if ( nArgCount < 2 || nArgCount > 5 )
3394 {
3395 rPar.Get(0)->PutLong(0);
3396 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3397 }
3398 else
3399 {
3400 sal_uInt16 nOptions = vos::OProcess::TOption_SearchPath|
3401 vos::OProcess::TOption_Detached;
3402 String aCmdLine = rPar.Get(1)->GetString();
3403 // Zusaetzliche Parameter anhaengen, es muss eh alles geparsed werden
3404 if( nArgCount >= 4 )
3405 {
3406 aCmdLine.AppendAscii( " " );
3407 aCmdLine += rPar.Get(3)->GetString();
3408 }
3409 else if( !aCmdLine.Len() )
3410 {
3411 // Spezial-Behandlung (leere Liste) vermeiden
3412 aCmdLine.AppendAscii( " " );
3413 }
3414 sal_uInt16 nLen = aCmdLine.Len();
3415
3416 // #55735 Wenn Parameter dabei sind, muessen die abgetrennt werden
3417 // #72471 Auch die einzelnen Parameter trennen
3418 std::list<String> aTokenList;
3419 String aToken;
3420 sal_uInt16 i = 0;
3421 sal_Unicode c;
3422 while( i < nLen )
3423 {
3424 // Spaces weg
3425 for ( ;; ++i )
3426 {
3427 c = aCmdLine.GetBuffer()[ i ];
3428 if ( c != ' ' && c != '\t' )
3429 break;
3430 }
3431
3432 if( c == '\"' || c == '\'' )
3433 {
3434 sal_uInt16 iFoundPos = aCmdLine.Search( c, i + 1 );
3435
3436 // Wenn nichts gefunden wurde, Rest kopieren
3437 if( iFoundPos == STRING_NOTFOUND )
3438 {
3439 aToken = aCmdLine.Copy( i, STRING_LEN );
3440 i = nLen;
3441 }
3442 else
3443 {
3444 aToken = aCmdLine.Copy( i + 1, (iFoundPos - i - 1) );
3445 i = iFoundPos + 1;
3446 }
3447 }
3448 else
3449 {
3450 sal_uInt16 iFoundSpacePos = aCmdLine.Search( ' ', i );
3451 sal_uInt16 iFoundTabPos = aCmdLine.Search( '\t', i );
3452 sal_uInt16 iFoundPos = Min( iFoundSpacePos, iFoundTabPos );
3453
3454 // Wenn nichts gefunden wurde, Rest kopieren
3455 if( iFoundPos == STRING_NOTFOUND )
3456 {
3457 aToken = aCmdLine.Copy( i, STRING_LEN );
3458 i = nLen;
3459 }
3460 else
3461 {
3462 aToken = aCmdLine.Copy( i, (iFoundPos - i) );
3463 i = iFoundPos;
3464 }
3465 }
3466
3467 // In die Liste uebernehmen
3468 aTokenList.push_back( aToken );
3469 }
3470 // #55735 / #72471 Ende
3471
3472 sal_Int16 nWinStyle = 0;
3473 if( nArgCount >= 3 )
3474 {
3475 nWinStyle = rPar.Get(2)->GetInteger();
3476 switch( nWinStyle )
3477 {
3478 case 2:
3479 nOptions |= vos::OProcess::TOption_Minimized;
3480 break;
3481 case 3:
3482 nOptions |= vos::OProcess::TOption_Maximized;
3483 break;
3484 case 10:
3485 nOptions |= vos::OProcess::TOption_FullScreen;
3486 break;
3487 }
3488
3489 sal_Bool bSync = sal_False;
3490 if( nArgCount >= 5 )
3491 bSync = rPar.Get(4)->GetBool();
3492 if( bSync )
3493 nOptions |= vos::OProcess::TOption_Wait;
3494 }
3495 vos::OProcess::TProcessOption eOptions =
3496 (vos::OProcess::TProcessOption)nOptions;
3497
3498
3499 // #72471 Parameter aufbereiten
3500 std::list<String>::const_iterator iter = aTokenList.begin();
3501 const String& rStr = *iter;
3502 ::rtl::OUString aOUStrProg( rStr.GetBuffer(), rStr.Len() );
3503 String aOUStrProgUNC = getFullPathUNC( aOUStrProg );
3504
3505 iter++;
3506
3507 sal_uInt16 nParamCount = sal::static_int_cast< sal_uInt16 >(
3508 aTokenList.size() - 1 );
3509 ::rtl::OUString* pArgumentList = NULL;
3510 //const char** pParamList = NULL;
3511 if( nParamCount )
3512 {
3513 pArgumentList = new ::rtl::OUString[ nParamCount ];
3514 //pParamList = new const char*[ nParamCount ];
3515 sal_uInt16 iList = 0;
3516 while( iter != aTokenList.end() )
3517 {
3518 const String& rParamStr = (*iter);
3519 pArgumentList[iList++] = ::rtl::OUString( rParamStr.GetBuffer(), rParamStr.Len() );
3520 //pParamList[iList++] = (*iter).GetStr();
3521 iter++;
3522 }
3523 }
3524
3525 //const char* pParams = aParams.Len() ? aParams.GetStr() : 0;
3526 vos::OProcess* pApp;
3527 pApp = new vos::OProcess( aOUStrProgUNC );
3528 sal_Bool bSucc;
3529 if( nParamCount == 0 )
3530 {
3531 bSucc = pApp->execute( eOptions ) == vos::OProcess::E_None;
3532 }
3533 else
3534 {
3535 vos::OArgumentList aArgList( pArgumentList, nParamCount );
3536 bSucc = pApp->execute( eOptions, aArgList ) == vos::OProcess::E_None;
3537 }
3538
3539 /*
3540 if( nParamCount == 0 )
3541 pApp = new vos::OProcess( pProg );
3542 else
3543 pApp = new vos::OProcess( pProg, pParamList, nParamCount );
3544 sal_Bool bSucc = pApp->execute( eOptions ) == vos::OProcess::E_None;
3545 */
3546
3547 delete pApp;
3548 delete[] pArgumentList;
3549 if( !bSucc )
3550 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
3551 else
3552 rPar.Get(0)->PutLong( 0 );
3553 }
3554 }
3555
RTLFUNC(VarType)3556 RTLFUNC(VarType)
3557 {
3558 (void)pBasic;
3559 (void)bWrite;
3560
3561 if ( rPar.Count() != 2 )
3562 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3563 else
3564 {
3565 SbxDataType eType = rPar.Get(1)->GetType();
3566 rPar.Get(0)->PutInteger( (sal_Int16)eType );
3567 }
3568 }
3569
3570 // Exported function
getBasicTypeName(SbxDataType eType)3571 String getBasicTypeName( SbxDataType eType )
3572 {
3573 static const char* pTypeNames[] =
3574 {
3575 "Empty", // SbxEMPTY
3576 "Null", // SbxNULL
3577 "Integer", // SbxINTEGER
3578 "Long", // SbxLONG
3579 "Single", // SbxSINGLE
3580 "Double", // SbxDOUBLE
3581 "Currency", // SbxCURRENCY
3582 "Date", // SbxDATE
3583 "String", // SbxSTRING
3584 "Object", // SbxOBJECT
3585 "Error", // SbxERROR
3586 "Boolean", // SbxBOOL
3587 "Variant", // SbxVARIANT
3588 "DataObject", // SbxDATAOBJECT
3589 "Unknown Type", //
3590 "Unknown Type", //
3591 "Char", // SbxCHAR
3592 "Byte", // SbxBYTE
3593 "UShort", // SbxUSHORT
3594 "ULong", // SbxULONG
3595 "Long64", // SbxLONG64
3596 "ULong64", // SbxULONG64
3597 "Int", // SbxINT
3598 "UInt", // SbxUINT
3599 "Void", // SbxVOID
3600 "HResult", // SbxHRESULT
3601 "Pointer", // SbxPOINTER
3602 "DimArray", // SbxDIMARRAY
3603 "CArray", // SbxCARRAY
3604 "Userdef", // SbxUSERDEF
3605 "Lpstr", // SbxLPSTR
3606 "Lpwstr", // SbxLPWSTR
3607 "Unknown Type", // SbxCoreSTRING
3608 "WString", // SbxWSTRING
3609 "WChar", // SbxWCHAR
3610 "Int64", // SbxSALINT64
3611 "UInt64", // SbxSALUINT64
3612 "Decimal", // SbxDECIMAL
3613 };
3614
3615 int nPos = ((int)eType) & 0x0FFF;
3616 sal_uInt16 nTypeNameCount = sizeof( pTypeNames ) / sizeof( char* );
3617 if ( nPos < 0 || nPos >= nTypeNameCount )
3618 nPos = nTypeNameCount - 1;
3619 String aRetStr = String::CreateFromAscii( pTypeNames[nPos] );
3620 return aRetStr;
3621 }
3622
RTLFUNC(TypeName)3623 RTLFUNC(TypeName)
3624 {
3625 (void)pBasic;
3626 (void)bWrite;
3627
3628 if ( rPar.Count() != 2 )
3629 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3630 else
3631 {
3632 SbxVariable* pVar = rPar.Get(1);
3633 SbxDataType eType = pVar->GetType();
3634
3635 // #i129350: In VBA compatibility mode, return "Nothing" for null objects
3636 sal_Bool bVBA = SbiRuntime::isVBAEnabled();
3637 if( bVBA && eType == SbxOBJECT && !pVar->GetObject() )
3638 {
3639 rPar.Get(0)->PutString( String( RTL_CONSTASCII_USTRINGPARAM("Nothing") ) );
3640 }
3641 else
3642 {
3643 sal_Bool bIsArray = ( ( eType & SbxARRAY ) != 0 );
3644 String aRetStr = getBasicTypeName( eType );
3645 if( bIsArray )
3646 aRetStr.AppendAscii( "()" );
3647 rPar.Get(0)->PutString( aRetStr );
3648 }
3649 }
3650 }
3651
RTLFUNC(Len)3652 RTLFUNC(Len)
3653 {
3654 (void)pBasic;
3655 (void)bWrite;
3656
3657 if ( rPar.Count() != 2 )
3658 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3659 else
3660 {
3661 const String& rStr = rPar.Get(1)->GetString();
3662 rPar.Get(0)->PutLong( (sal_Int32)rStr.Len() );
3663 }
3664 }
3665
RTLFUNC(DDEInitiate)3666 RTLFUNC(DDEInitiate)
3667 {
3668 (void)pBasic;
3669 (void)bWrite;
3670
3671 // No DDE for "virtual" portal users
3672 if( needSecurityRestrictions() )
3673 {
3674 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3675 return;
3676 }
3677
3678 int nArgs = (int)rPar.Count();
3679 if ( nArgs != 3 )
3680 {
3681 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3682 return;
3683 }
3684 const String& rApp = rPar.Get(1)->GetString();
3685 const String& rTopic = rPar.Get(2)->GetString();
3686
3687 SbiDdeControl* pDDE = pINST->GetDdeControl();
3688 sal_Int16 nChannel;
3689 SbError nDdeErr = pDDE->Initiate( rApp, rTopic, nChannel );
3690 if( nDdeErr )
3691 StarBASIC::Error( nDdeErr );
3692 else
3693 rPar.Get(0)->PutInteger( nChannel );
3694 }
3695
RTLFUNC(DDETerminate)3696 RTLFUNC(DDETerminate)
3697 {
3698 (void)pBasic;
3699 (void)bWrite;
3700
3701 // No DDE for "virtual" portal users
3702 if( needSecurityRestrictions() )
3703 {
3704 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3705 return;
3706 }
3707
3708 rPar.Get(0)->PutEmpty();
3709 int nArgs = (int)rPar.Count();
3710 if ( nArgs != 2 )
3711 {
3712 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3713 return;
3714 }
3715 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3716 SbiDdeControl* pDDE = pINST->GetDdeControl();
3717 SbError nDdeErr = pDDE->Terminate( nChannel );
3718 if( nDdeErr )
3719 StarBASIC::Error( nDdeErr );
3720 }
3721
RTLFUNC(DDETerminateAll)3722 RTLFUNC(DDETerminateAll)
3723 {
3724 (void)pBasic;
3725 (void)bWrite;
3726
3727 // No DDE for "virtual" portal users
3728 if( needSecurityRestrictions() )
3729 {
3730 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3731 return;
3732 }
3733
3734 rPar.Get(0)->PutEmpty();
3735 int nArgs = (int)rPar.Count();
3736 if ( nArgs != 1 )
3737 {
3738 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3739 return;
3740 }
3741
3742 SbiDdeControl* pDDE = pINST->GetDdeControl();
3743 SbError nDdeErr = pDDE->TerminateAll();
3744 if( nDdeErr )
3745 StarBASIC::Error( nDdeErr );
3746
3747 }
3748
RTLFUNC(DDERequest)3749 RTLFUNC(DDERequest)
3750 {
3751 (void)pBasic;
3752 (void)bWrite;
3753
3754 // No DDE for "virtual" portal users
3755 if( needSecurityRestrictions() )
3756 {
3757 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3758 return;
3759 }
3760
3761 int nArgs = (int)rPar.Count();
3762 if ( nArgs != 3 )
3763 {
3764 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3765 return;
3766 }
3767 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3768 const String& rItem = rPar.Get(2)->GetString();
3769 SbiDdeControl* pDDE = pINST->GetDdeControl();
3770 String aResult;
3771 SbError nDdeErr = pDDE->Request( nChannel, rItem, aResult );
3772 if( nDdeErr )
3773 StarBASIC::Error( nDdeErr );
3774 else
3775 rPar.Get(0)->PutString( aResult );
3776 }
3777
RTLFUNC(DDEExecute)3778 RTLFUNC(DDEExecute)
3779 {
3780 (void)pBasic;
3781 (void)bWrite;
3782
3783 // No DDE for "virtual" portal users
3784 if( needSecurityRestrictions() )
3785 {
3786 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3787 return;
3788 }
3789
3790 rPar.Get(0)->PutEmpty();
3791 int nArgs = (int)rPar.Count();
3792 if ( nArgs != 3 )
3793 {
3794 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3795 return;
3796 }
3797 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3798 const String& rCommand = rPar.Get(2)->GetString();
3799 SbiDdeControl* pDDE = pINST->GetDdeControl();
3800 SbError nDdeErr = pDDE->Execute( nChannel, rCommand );
3801 if( nDdeErr )
3802 StarBASIC::Error( nDdeErr );
3803 }
3804
RTLFUNC(DDEPoke)3805 RTLFUNC(DDEPoke)
3806 {
3807 (void)pBasic;
3808 (void)bWrite;
3809
3810 // No DDE for "virtual" portal users
3811 if( needSecurityRestrictions() )
3812 {
3813 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3814 return;
3815 }
3816
3817 rPar.Get(0)->PutEmpty();
3818 int nArgs = (int)rPar.Count();
3819 if ( nArgs != 4 )
3820 {
3821 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3822 return;
3823 }
3824 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3825 const String& rItem = rPar.Get(2)->GetString();
3826 const String& rData = rPar.Get(3)->GetString();
3827 SbiDdeControl* pDDE = pINST->GetDdeControl();
3828 SbError nDdeErr = pDDE->Poke( nChannel, rItem, rData );
3829 if( nDdeErr )
3830 StarBASIC::Error( nDdeErr );
3831 }
3832
3833
RTLFUNC(FreeFile)3834 RTLFUNC(FreeFile)
3835 {
3836 (void)pBasic;
3837 (void)bWrite;
3838
3839 if ( rPar.Count() != 1 )
3840 {
3841 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3842 return;
3843 }
3844 SbiIoSystem* pIO = pINST->GetIoSystem();
3845 short nChannel = 1;
3846 while( nChannel < CHANNELS )
3847 {
3848 SbiStream* pStrm = pIO->GetStream( nChannel );
3849 if( !pStrm )
3850 {
3851 rPar.Get(0)->PutInteger( nChannel );
3852 return;
3853 }
3854 nChannel++;
3855 }
3856 StarBASIC::Error( SbERR_TOO_MANY_FILES );
3857 }
3858
RTLFUNC(LBound)3859 RTLFUNC(LBound)
3860 {
3861 (void)pBasic;
3862 (void)bWrite;
3863
3864 sal_uInt16 nParCount = rPar.Count();
3865 if ( nParCount != 3 && nParCount != 2 )
3866 {
3867 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3868 return;
3869 }
3870 SbxBase* pParObj = rPar.Get(1)->GetObject();
3871 SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj);
3872 if( pArr )
3873 {
3874 sal_Int32 nLower, nUpper;
3875 short nDim = (nParCount == 3) ? (short)rPar.Get(2)->GetInteger() : 1;
3876 if( !pArr->GetDim32( nDim, nLower, nUpper ) )
3877 StarBASIC::Error( SbERR_OUT_OF_RANGE );
3878 else
3879 rPar.Get(0)->PutLong( nLower );
3880 }
3881 else
3882 StarBASIC::Error( SbERR_MUST_HAVE_DIMS );
3883 }
3884
RTLFUNC(UBound)3885 RTLFUNC(UBound)
3886 {
3887 (void)pBasic;
3888 (void)bWrite;
3889
3890 sal_uInt16 nParCount = rPar.Count();
3891 if ( nParCount != 3 && nParCount != 2 )
3892 {
3893 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3894 return;
3895 }
3896
3897 SbxBase* pParObj = rPar.Get(1)->GetObject();
3898 SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj);
3899 if( pArr )
3900 {
3901 sal_Int32 nLower, nUpper;
3902 short nDim = (nParCount == 3) ? (short)rPar.Get(2)->GetInteger() : 1;
3903 if( !pArr->GetDim32( nDim, nLower, nUpper ) )
3904 StarBASIC::Error( SbERR_OUT_OF_RANGE );
3905 else
3906 rPar.Get(0)->PutLong( nUpper );
3907 }
3908 else
3909 StarBASIC::Error( SbERR_MUST_HAVE_DIMS );
3910 }
3911
RTLFUNC(RGB)3912 RTLFUNC(RGB)
3913 {
3914 (void)pBasic;
3915 (void)bWrite;
3916
3917 if ( rPar.Count() != 4 )
3918 {
3919 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3920 return;
3921 }
3922
3923 sal_uIntPtr nRed = rPar.Get(1)->GetInteger() & 0xFF;
3924 sal_uIntPtr nGreen = rPar.Get(2)->GetInteger() & 0xFF;
3925 sal_uIntPtr nBlue = rPar.Get(3)->GetInteger() & 0xFF;
3926 sal_uIntPtr nRGB;
3927
3928 SbiInstance* pInst = pINST;
3929 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
3930 if( bCompatibility )
3931 {
3932 nRGB = (nBlue << 16) | (nGreen << 8) | nRed;
3933 }
3934 else
3935 {
3936 nRGB = (nRed << 16) | (nGreen << 8) | nBlue;
3937 }
3938 rPar.Get(0)->PutLong( nRGB );
3939 }
3940
RTLFUNC(QBColor)3941 RTLFUNC(QBColor)
3942 {
3943 (void)pBasic;
3944 (void)bWrite;
3945
3946 static const sal_Int32 pRGB[] =
3947 {
3948 0x000000,
3949 0x800000,
3950 0x008000,
3951 0x808000,
3952 0x000080,
3953 0x800080,
3954 0x008080,
3955 0xC0C0C0,
3956 0x808080,
3957 0xFF0000,
3958 0x00FF00,
3959 0xFFFF00,
3960 0x0000FF,
3961 0xFF00FF,
3962 0x00FFFF,
3963 0xFFFFFF,
3964 };
3965
3966 if ( rPar.Count() != 2 )
3967 {
3968 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3969 return;
3970 }
3971
3972 sal_Int16 nCol = rPar.Get(1)->GetInteger();
3973 if( nCol < 0 || nCol > 15 )
3974 {
3975 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3976 return;
3977 }
3978 sal_Int32 nRGB = pRGB[ nCol ];
3979 rPar.Get(0)->PutLong( nRGB );
3980 }
3981
3982 // StrConv(string, conversion, LCID)
RTLFUNC(StrConv)3983 RTLFUNC(StrConv)
3984 {
3985 (void)pBasic;
3986 (void)bWrite;
3987
3988 sal_uIntPtr nArgCount = rPar.Count()-1;
3989 if( nArgCount < 2 || nArgCount > 3 )
3990 {
3991 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3992 return;
3993 }
3994
3995 String aOldStr = rPar.Get(1)->GetString();
3996 sal_Int32 nConversion = rPar.Get(2)->GetLong();
3997
3998 sal_uInt16 nLanguage = LANGUAGE_SYSTEM;
3999 if( nArgCount == 3 )
4000 {
4001 // LCID not supported now
4002 //nLanguage = rPar.Get(3)->GetInteger();
4003 }
4004
4005 sal_uInt16 nOldLen = aOldStr.Len();
4006 if( nOldLen == 0 )
4007 {
4008 // null string,return
4009 rPar.Get(0)->PutString(aOldStr);
4010 return;
4011 }
4012
4013 sal_Int32 nType = 0;
4014 if ( (nConversion & 0x03) == 3 ) // vbProperCase
4015 {
4016 CharClass& rCharClass = GetCharClass();
4017 aOldStr = rCharClass.toTitle( aOldStr.ToLowerAscii(), 0, nOldLen );
4018 }
4019 else if ( (nConversion & 0x01) == 1 ) // vbUpperCase
4020 nType |= ::com::sun::star::i18n::TransliterationModules_LOWERCASE_UPPERCASE;
4021 else if ( (nConversion & 0x02) == 2 ) // vbLowerCase
4022 nType |= ::com::sun::star::i18n::TransliterationModules_UPPERCASE_LOWERCASE;
4023
4024 if ( (nConversion & 0x04) == 4 ) // vbWide
4025 nType |= ::com::sun::star::i18n::TransliterationModules_HALFWIDTH_FULLWIDTH;
4026 else if ( (nConversion & 0x08) == 8 ) // vbNarrow
4027 nType |= ::com::sun::star::i18n::TransliterationModules_FULLWIDTH_HALFWIDTH;
4028
4029 if ( (nConversion & 0x10) == 16) // vbKatakana
4030 nType |= ::com::sun::star::i18n::TransliterationModules_HIRAGANA_KATAKANA;
4031 else if ( (nConversion & 0x20) == 32 ) // vbHiragana
4032 nType |= ::com::sun::star::i18n::TransliterationModules_KATAKANA_HIRAGANA;
4033
4034 String aNewStr( aOldStr );
4035 if( nType != 0 )
4036 {
4037 com::sun::star::uno::Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory();
4038 ::utl::TransliterationWrapper aTransliterationWrapper( xSMgr,nType );
4039 com::sun::star::uno::Sequence<sal_Int32> aOffsets;
4040 aTransliterationWrapper.loadModuleIfNeeded( nLanguage );
4041 aNewStr = aTransliterationWrapper.transliterate( aOldStr, nLanguage, 0, nOldLen, &aOffsets );
4042 }
4043
4044 if ( (nConversion & 0x40) == 64 ) // vbUnicode
4045 {
4046 // convert the string to byte string, preserving unicode (2 bytes per character)
4047 sal_uInt16 nSize = aNewStr.Len()*2;
4048 const sal_Unicode* pSrc = aNewStr.GetBuffer();
4049 sal_Char* pChar = new sal_Char[nSize+1];
4050 for( sal_uInt16 i=0; i < nSize; i++ )
4051 {
4052 pChar[i] = static_cast< sal_Char >( i%2 ? ((*pSrc) >> 8) & 0xff : (*pSrc) & 0xff );
4053 if( i%2 )
4054 pSrc++;
4055 }
4056 pChar[nSize] = '\0';
4057 ::rtl::OString aOStr(pChar);
4058
4059 // there is no concept about default codepage in unix. so it is incorrectly in unix
4060 ::rtl::OUString aOUStr = ::rtl::OStringToOUString(aOStr, osl_getThreadTextEncoding());
4061 aNewStr = String(aOUStr);
4062 rPar.Get(0)->PutString( aNewStr );
4063 return;
4064 }
4065 else if ( (nConversion & 0x80) == 128 ) // vbFromUnicode
4066 {
4067 ::rtl::OUString aOUStr(aNewStr);
4068 // there is no concept about default codepage in unix. so it is incorrectly in unix
4069 ::rtl::OString aOStr = ::rtl::OUStringToOString(aNewStr,osl_getThreadTextEncoding());
4070 const sal_Char* pChar = aOStr.getStr();
4071 sal_uInt16 nArraySize = static_cast< sal_uInt16 >( aOStr.getLength() );
4072 SbxDimArray* pArray = new SbxDimArray(SbxBYTE);
4073 bool bIncIndex = (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() );
4074 if(nArraySize)
4075 {
4076 if( bIncIndex )
4077 pArray->AddDim( 1, nArraySize );
4078 else
4079 pArray->AddDim( 0, nArraySize-1 );
4080 }
4081 else
4082 {
4083 pArray->unoAddDim( 0, -1 );
4084 }
4085
4086 for( sal_uInt16 i=0; i< nArraySize; i++)
4087 {
4088 SbxVariable* pNew = new SbxVariable( SbxBYTE );
4089 pNew->PutByte(*pChar);
4090 pChar++;
4091 pNew->SetFlag( SBX_WRITE );
4092 short index = i;
4093 if( bIncIndex )
4094 ++index;
4095 pArray->Put( pNew, &index );
4096 }
4097
4098 SbxVariableRef refVar = rPar.Get(0);
4099 sal_uInt16 nFlags = refVar->GetFlags();
4100 refVar->ResetFlag( SBX_FIXED );
4101 refVar->PutObject( pArray );
4102 refVar->SetFlags( nFlags );
4103 refVar->SetParameters( NULL );
4104 return;
4105 }
4106
4107 rPar.Get(0)->PutString(aNewStr);
4108 }
4109
4110
RTLFUNC(Beep)4111 RTLFUNC(Beep)
4112 {
4113 (void)pBasic;
4114 (void)bWrite;
4115
4116 if ( rPar.Count() != 1 )
4117 {
4118 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4119 return;
4120 }
4121 Sound::Beep();
4122 }
4123
RTLFUNC(Load)4124 RTLFUNC(Load)
4125 {
4126 (void)pBasic;
4127 (void)bWrite;
4128
4129 if( rPar.Count() != 2 )
4130 {
4131 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4132 return;
4133 }
4134
4135 // Diesen Call einfach an das Object weiterreichen
4136 SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
4137 if ( pObj )
4138 {
4139 if( pObj->IsA( TYPE( SbUserFormModule ) ) )
4140 {
4141 ((SbUserFormModule*)pObj)->Load();
4142 }
4143 else if( pObj->IsA( TYPE( SbxObject ) ) )
4144 {
4145 SbxVariable* pVar = ((SbxObject*)pObj)->
4146 Find( String( RTL_CONSTASCII_USTRINGPARAM("Load") ), SbxCLASS_METHOD );
4147 if( pVar )
4148 pVar->GetInteger();
4149 }
4150 }
4151 }
4152
RTLFUNC(Unload)4153 RTLFUNC(Unload)
4154 {
4155 (void)pBasic;
4156 (void)bWrite;
4157
4158 rPar.Get(0)->PutEmpty();
4159 if( rPar.Count() != 2 )
4160 {
4161 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4162 return;
4163 }
4164
4165 // Diesen Call einfach an das Object weitereichen
4166 SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
4167 if ( pObj )
4168 {
4169 if( pObj->IsA( TYPE( SbUserFormModule ) ) )
4170 {
4171 SbUserFormModule* pFormModule = ( SbUserFormModule* )pObj;
4172 pFormModule->Unload();
4173 }
4174 else if( pObj->IsA( TYPE( SbxObject ) ) )
4175 {
4176 SbxVariable* pVar = ((SbxObject*)pObj)->
4177 Find( String( RTL_CONSTASCII_USTRINGPARAM("Unload") ), SbxCLASS_METHOD );
4178 if( pVar )
4179 pVar->GetInteger();
4180 }
4181 }
4182 }
4183
RTLFUNC(LoadPicture)4184 RTLFUNC(LoadPicture)
4185 {
4186 (void)pBasic;
4187 (void)bWrite;
4188
4189 if( rPar.Count() != 2 )
4190 {
4191 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4192 return;
4193 }
4194
4195 String aFileURL = getFullPath( rPar.Get(1)->GetString() );
4196 SvStream* pStream = utl::UcbStreamHelper::CreateStream( aFileURL, STREAM_READ );
4197 if( pStream != NULL )
4198 {
4199 Bitmap aBmp;
4200 ReadDIB(aBmp, *pStream, true);
4201 Graphic aGraphic(aBmp);
4202
4203 SbxObjectRef xRef = new SbStdPicture;
4204 ((SbStdPicture*)(SbxObject*)xRef)->SetGraphic( aGraphic );
4205 rPar.Get(0)->PutObject( xRef );
4206 }
4207 delete pStream;
4208 }
4209
RTLFUNC(SavePicture)4210 RTLFUNC(SavePicture)
4211 {
4212 (void)pBasic;
4213 (void)bWrite;
4214
4215 rPar.Get(0)->PutEmpty();
4216 if( rPar.Count() != 3 )
4217 {
4218 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4219 return;
4220 }
4221
4222 SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
4223 if( pObj->IsA( TYPE( SbStdPicture ) ) )
4224 {
4225 SvFileStream aOStream( rPar.Get(2)->GetString(), STREAM_WRITE | STREAM_TRUNC );
4226 Graphic aGraphic = ((SbStdPicture*)pObj)->GetGraphic();
4227 aOStream << aGraphic;
4228 }
4229 }
4230
4231
4232 //-----------------------------------------------------------------------------------------
4233
RTLFUNC(AboutStarBasic)4234 RTLFUNC(AboutStarBasic)
4235 {
4236 (void)pBasic;
4237 (void)bWrite;
4238 (void)rPar;
4239 }
4240
RTLFUNC(MsgBox)4241 RTLFUNC(MsgBox)
4242 {
4243 (void)pBasic;
4244 (void)bWrite;
4245
4246 static const WinBits nStyleMap[] =
4247 {
4248 WB_OK, // MB_OK
4249 WB_OK_CANCEL, // MB_OKCANCEL
4250 WB_ABORT_RETRY_IGNORE, // MB_ABORTRETRYIGNORE
4251 WB_YES_NO_CANCEL, // MB_YESNOCANCEL
4252 WB_YES_NO, // MB_YESNO
4253 WB_RETRY_CANCEL // MB_RETRYCANCEL
4254 };
4255 static const sal_Int16 nButtonMap[] =
4256 {
4257 2, // #define RET_CANCEL sal_False
4258 1, // #define RET_OK sal_True
4259 6, // #define RET_YES 2
4260 7, // #define RET_NO 3
4261 4 // #define RET_RETRY 4
4262 };
4263
4264
4265 sal_uInt16 nArgCount = (sal_uInt16)rPar.Count();
4266 if( nArgCount < 2 || nArgCount > 6 )
4267 {
4268 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4269 return;
4270 }
4271 WinBits nWinBits;
4272 WinBits nType = 0; // MB_OK
4273 if( nArgCount >= 3 )
4274 nType = (WinBits)rPar.Get(2)->GetInteger();
4275 WinBits nStyle = nType;
4276 nStyle &= 15; // Bits 4-16 loeschen
4277 if( nStyle > 5 )
4278 nStyle = 0;
4279
4280 nWinBits = nStyleMap[ nStyle ];
4281
4282 WinBits nWinDefBits;
4283 nWinDefBits = (WB_DEF_OK | WB_DEF_RETRY | WB_DEF_YES);
4284 if( nType & 256 )
4285 {
4286 if( nStyle == 5 )
4287 nWinDefBits = WB_DEF_CANCEL;
4288 else if( nStyle == 2 )
4289 nWinDefBits = WB_DEF_RETRY;
4290 else
4291 nWinDefBits = (WB_DEF_CANCEL | WB_DEF_RETRY | WB_DEF_NO);
4292 }
4293 else if( nType & 512 )
4294 {
4295 if( nStyle == 2)
4296 nWinDefBits = WB_DEF_IGNORE;
4297 else
4298 nWinDefBits = WB_DEF_CANCEL;
4299 }
4300 else if( nStyle == 2)
4301 nWinDefBits = WB_DEF_CANCEL;
4302 nWinBits |= nWinDefBits;
4303
4304 String aMsg = rPar.Get(1)->GetString();
4305 String aTitle;
4306 if( nArgCount >= 4 )
4307 aTitle = rPar.Get(3)->GetString();
4308 else
4309 aTitle = GetpApp()->GetDisplayName();
4310
4311 nType &= (16+32+64);
4312 MessBox* pBox = 0;
4313 Window* pParent = GetpApp()->GetDefDialogParent();
4314 switch( nType )
4315 {
4316 case 16:
4317 pBox = new ErrorBox( pParent, nWinBits, aMsg );
4318 break;
4319 case 32:
4320 pBox = new QueryBox( pParent, nWinBits, aMsg );
4321 break;
4322 case 48:
4323 pBox = new WarningBox( pParent, nWinBits, aMsg );
4324 break;
4325 case 64:
4326 pBox = new InfoBox( pParent, nWinBits, aMsg );
4327 break;
4328 default:
4329 pBox = new MessBox( pParent, nWinBits, aTitle, aMsg );
4330 }
4331 pBox->SetText( aTitle );
4332 sal_uInt16 nRet = (sal_uInt16)pBox->Execute();
4333 if( nRet == sal_True )
4334 nRet = 1;
4335
4336 sal_Int16 nMappedRet;
4337 if( nStyle == 2 )
4338 {
4339 nMappedRet = nRet;
4340 if( nMappedRet == 0 )
4341 nMappedRet = 3; // Abort
4342 }
4343 else
4344 nMappedRet = nButtonMap[ nRet ];
4345
4346 rPar.Get(0)->PutInteger( nMappedRet );
4347 delete pBox;
4348 }
4349
RTLFUNC(SetAttr)4350 RTLFUNC(SetAttr) // JSM
4351 {
4352 (void)pBasic;
4353 (void)bWrite;
4354
4355 rPar.Get(0)->PutEmpty();
4356 if ( rPar.Count() == 3 )
4357 {
4358 String aStr = rPar.Get(1)->GetString();
4359 sal_Int16 nFlags = rPar.Get(2)->GetInteger();
4360
4361 // <-- UCB
4362 if( hasUno() )
4363 {
4364 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
4365 if( xSFI.is() )
4366 {
4367 try
4368 {
4369 sal_Bool bReadOnly = (nFlags & 0x0001) != 0; // ATTR_READONLY
4370 xSFI->setReadOnly( aStr, bReadOnly );
4371 sal_Bool bHidden = (nFlags & 0x0002) != 0; // ATTR_HIDDEN
4372 xSFI->setHidden( aStr, bHidden );
4373 }
4374 catch( Exception & )
4375 {
4376 StarBASIC::Error( ERRCODE_IO_GENERAL );
4377 }
4378 }
4379 }
4380 else
4381 // --> UCB
4382 {
4383 #ifdef _OLD_FILE_IMPL
4384 // #57064 Bei virtuellen URLs den Real-Path extrahieren
4385 DirEntry aEntry( aStr );
4386 String aFile = aEntry.GetFull();
4387 ByteString aByteFile( aFile, gsl_getSystemTextEncoding() );
4388 #ifdef WNT
4389 if (!SetFileAttributes (aByteFile.GetBuffer(),(DWORD)nFlags))
4390 StarBASIC::Error(SbERR_FILE_NOT_FOUND);
4391 #endif
4392 #ifdef OS2
4393 FILESTATUS3 aFileStatus;
4394 APIRET rc = DosQueryPathInfo(aByteFile.GetBuffer(),1,
4395 &aFileStatus,sizeof(FILESTATUS3));
4396 if (!rc)
4397 {
4398 if (aFileStatus.attrFile != nFlags)
4399 {
4400 aFileStatus.attrFile = nFlags;
4401 rc = DosSetPathInfo(aFile.GetStr(),1,
4402 &aFileStatus,sizeof(FILESTATUS3),0);
4403 if (rc)
4404 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
4405 }
4406 }
4407 else
4408 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
4409 #endif
4410 #else
4411 // Not implemented
4412 #endif
4413 }
4414 }
4415 else
4416 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4417 }
4418
RTLFUNC(Reset)4419 RTLFUNC(Reset) // JSM
4420 {
4421 (void)pBasic;
4422 (void)bWrite;
4423 (void)rPar;
4424
4425 SbiIoSystem* pIO = pINST->GetIoSystem();
4426 if (pIO)
4427 pIO->CloseAll();
4428 }
4429
RTLFUNC(DumpAllObjects)4430 RTLFUNC(DumpAllObjects)
4431 {
4432 (void)pBasic;
4433 (void)bWrite;
4434
4435 sal_uInt16 nArgCount = (sal_uInt16)rPar.Count();
4436 if( nArgCount < 2 || nArgCount > 3 )
4437 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4438 else if( !pBasic )
4439 StarBASIC::Error( SbERR_INTERNAL_ERROR );
4440 else
4441 {
4442 SbxObject* p = pBasic;
4443 while( p->GetParent() )
4444 p = p->GetParent();
4445 SvFileStream aStrm( rPar.Get( 1 )->GetString(),
4446 STREAM_WRITE | STREAM_TRUNC );
4447 p->Dump( aStrm, rPar.Get( 2 )->GetBool() );
4448 aStrm.Close();
4449 if( aStrm.GetError() != SVSTREAM_OK )
4450 StarBASIC::Error( SbERR_IO_ERROR );
4451 }
4452 }
4453
4454
RTLFUNC(FileExists)4455 RTLFUNC(FileExists)
4456 {
4457 (void)pBasic;
4458 (void)bWrite;
4459
4460 if ( rPar.Count() == 2 )
4461 {
4462 String aStr = rPar.Get(1)->GetString();
4463 sal_Bool bExists = sal_False;
4464
4465 // <-- UCB
4466 if( hasUno() )
4467 {
4468 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
4469 if( xSFI.is() )
4470 {
4471 try
4472 {
4473 bExists = xSFI->exists( aStr );
4474 }
4475 catch( Exception & )
4476 {
4477 StarBASIC::Error( ERRCODE_IO_GENERAL );
4478 }
4479 }
4480 }
4481 else
4482 // --> UCB
4483 {
4484 #ifdef _OLD_FILE_IMPL
4485 DirEntry aEntry( aStr );
4486 bExists = aEntry.Exists();
4487 #else
4488 DirectoryItem aItem;
4489 FileBase::RC nRet = DirectoryItem::get( getFullPathUNC( aStr ), aItem );
4490 bExists = (nRet == FileBase::E_None);
4491 #endif
4492 }
4493 rPar.Get(0)->PutBool( bExists );
4494 }
4495 else
4496 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4497 }
4498
RTLFUNC(Partition)4499 RTLFUNC(Partition)
4500 {
4501 (void)pBasic;
4502 (void)bWrite;
4503
4504 if ( rPar.Count() != 5 )
4505 {
4506 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4507 return;
4508 }
4509
4510 sal_Int32 nNumber = rPar.Get(1)->GetLong();
4511 sal_Int32 nStart = rPar.Get(2)->GetLong();
4512 sal_Int32 nStop = rPar.Get(3)->GetLong();
4513 sal_Int32 nInterval = rPar.Get(4)->GetLong();
4514
4515 if( nStart < 0 || nStop <= nStart || nInterval < 1 )
4516 {
4517 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4518 return;
4519 }
4520
4521 // the Partition function inserts leading spaces before lowervalue and uppervalue
4522 // so that they both have the same number of characters as the string
4523 // representation of the value (Stop + 1). This ensures that if you use the output
4524 // of the Partition function with several values of Number, the resulting text
4525 // will be handled properly during any subsequent sort operation.
4526
4527 // calculate the maximun number of characters before lowervalue and uppervalue
4528 ::rtl::OUString aBeforeStart = ::rtl::OUString::valueOf( nStart - 1 );
4529 ::rtl::OUString aAfterStop = ::rtl::OUString::valueOf( nStop + 1 );
4530 sal_Int32 nLen1 = aBeforeStart.getLength();
4531 sal_Int32 nLen2 = aAfterStop.getLength();
4532 sal_Int32 nLen = nLen1 >= nLen2 ? nLen1:nLen2;
4533
4534 ::rtl::OUStringBuffer aRetStr( nLen * 2 + 1);
4535 ::rtl::OUString aLowerValue;
4536 ::rtl::OUString aUpperValue;
4537 if( nNumber < nStart )
4538 {
4539 aUpperValue = aBeforeStart;
4540 }
4541 else if( nNumber > nStop )
4542 {
4543 aLowerValue = aAfterStop;
4544 }
4545 else
4546 {
4547 sal_Int32 nLowerValue = nNumber;
4548 sal_Int32 nUpperValue = nLowerValue;
4549 if( nInterval > 1 )
4550 {
4551 nLowerValue = ((( nNumber - nStart ) / nInterval ) * nInterval ) + nStart;
4552 nUpperValue = nLowerValue + nInterval - 1;
4553 }
4554
4555 aLowerValue = ::rtl::OUString::valueOf( nLowerValue );
4556 aUpperValue = ::rtl::OUString::valueOf( nUpperValue );
4557 }
4558
4559 nLen1 = aLowerValue.getLength();
4560 nLen2 = aUpperValue.getLength();
4561
4562 if( nLen > nLen1 )
4563 {
4564 // appending the leading spaces for the lowervalue
4565 for ( sal_Int32 i= (nLen - nLen1) ; i > 0; --i )
4566 aRetStr.appendAscii(" ");
4567 }
4568 aRetStr.append( aLowerValue ).appendAscii(":");
4569 if( nLen > nLen2 )
4570 {
4571 // appending the leading spaces for the uppervalue
4572 for ( sal_Int32 i= (nLen - nLen2) ; i > 0; --i )
4573 aRetStr.appendAscii(" ");
4574 }
4575 aRetStr.append( aUpperValue );
4576 rPar.Get(0)->PutString( String(aRetStr.makeStringAndClear()) );
4577 }
4578