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 - nFindStrLen + nReplaceStrLen + 1;
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(Tan)1711 RTLFUNC(Tan)
1712 {
1713 (void)pBasic;
1714 (void)bWrite;
1715
1716 if ( rPar.Count() < 2 )
1717 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1718 else
1719 {
1720 SbxVariableRef pArg = rPar.Get( 1 );
1721 rPar.Get( 0 )->PutDouble( tan( pArg->GetDouble() ) );
1722 }
1723 }
1724
RTLFUNC(UCase)1725 RTLFUNC(UCase)
1726 {
1727 (void)pBasic;
1728 (void)bWrite;
1729
1730 if ( rPar.Count() < 2 )
1731 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1732 else
1733 {
1734 CharClass& rCharClass = GetCharClass();
1735 String aStr( rPar.Get(1)->GetString() );
1736 rCharClass.toUpper( aStr );
1737 rPar.Get(0)->PutString( aStr );
1738 }
1739 }
1740
1741
RTLFUNC(Val)1742 RTLFUNC(Val)
1743 {
1744 (void)pBasic;
1745 (void)bWrite;
1746
1747 if ( rPar.Count() < 2 )
1748 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1749 else
1750 {
1751 double nResult = 0.0;
1752 char* pEndPtr;
1753
1754 String aStr( rPar.Get(1)->GetString() );
1755 // lt. Mikkysoft bei Kommas abbrechen!
1756 // for( sal_uInt16 n=0; n < aStr.Len(); n++ )
1757 // if( aStr[n] == ',' ) aStr[n] = '.';
1758
1759 FilterWhiteSpace( aStr );
1760 if ( aStr.GetBuffer()[0] == '&' && aStr.Len() > 1 )
1761 {
1762 int nRadix = 10;
1763 char aChar = (char)aStr.GetBuffer()[1];
1764 if ( aChar == 'h' || aChar == 'H' )
1765 nRadix = 16;
1766 else if ( aChar == 'o' || aChar == 'O' )
1767 nRadix = 8;
1768 if ( nRadix != 10 )
1769 {
1770 ByteString aByteStr( aStr, gsl_getSystemTextEncoding() );
1771 sal_Int16 nlResult = (sal_Int16)strtol( aByteStr.GetBuffer()+2, &pEndPtr, nRadix);
1772 nResult = (double)nlResult;
1773 }
1774 }
1775 else
1776 {
1777 // #57844 Lokalisierte Funktion benutzen
1778 nResult = ::rtl::math::stringToDouble( aStr, '.', ',', NULL, NULL );
1779 checkArithmeticOverflow( nResult );
1780 // ATL: nResult = strtod( aStr.GetStr(), &pEndPtr );
1781 }
1782
1783 rPar.Get(0)->PutDouble( nResult );
1784 }
1785 }
1786
1787
1788 // Helper functions for date conversion
implGetDateDay(double aDate)1789 sal_Int16 implGetDateDay( double aDate )
1790 {
1791 aDate -= 2.0; // normieren: 1.1.1900 => 0.0
1792 aDate = floor( aDate );
1793 Date aRefDate( 1, 1, 1900 );
1794 aRefDate += (sal_uIntPtr)aDate;
1795
1796 sal_Int16 nRet = (sal_Int16)( aRefDate.GetDay() );
1797 return nRet;
1798 }
1799
implGetDateMonth(double aDate)1800 sal_Int16 implGetDateMonth( double aDate )
1801 {
1802 Date aRefDate( 1,1,1900 );
1803 long nDays = (long)aDate;
1804 nDays -= 2; // normieren: 1.1.1900 => 0.0
1805 aRefDate += nDays;
1806 sal_Int16 nRet = (sal_Int16)( aRefDate.GetMonth() );
1807 return nRet;
1808 }
1809
implGetDateYear(double aDate)1810 sal_Int16 implGetDateYear( double aDate )
1811 {
1812 Date aRefDate( 1,1,1900 );
1813 long nDays = (long) aDate;
1814 nDays -= 2; // normieren: 1.1.1900 => 0.0
1815 aRefDate += nDays;
1816 sal_Int16 nRet = (sal_Int16)( aRefDate.GetYear() );
1817 return nRet;
1818 }
1819
implDateSerial(sal_Int16 nYear,sal_Int16 nMonth,sal_Int16 nDay,double & rdRet)1820 sal_Bool implDateSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay, double& rdRet )
1821 {
1822 if ( nYear < 30 && SbiRuntime::isVBAEnabled() )
1823 nYear += 2000;
1824 else if ( nYear < 100 )
1825 nYear += 1900;
1826 Date aCurDate( nDay, nMonth, nYear );
1827 if ((nYear < 100 || nYear > 9999) )
1828 {
1829 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1830 return sal_False;
1831 }
1832 if ( !SbiRuntime::isVBAEnabled() )
1833 {
1834 if ( (nMonth < 1 || nMonth > 12 )||
1835 (nDay < 1 || nDay > 31 ) )
1836 {
1837 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1838 return sal_False;
1839 }
1840 }
1841 else
1842 {
1843 // grab the year & month
1844 aCurDate = Date( 1, (( nMonth % 12 ) > 0 ) ? ( nMonth % 12 ) : 12 + ( nMonth % 12 ), nYear );
1845
1846 // adjust year based on month value
1847 // e.g. 2000, 0, xx = 1999, 12, xx ( or December of the previous year )
1848 // 2000, 13, xx = 2001, 1, xx ( or January of the following year )
1849 if( ( nMonth < 1 ) || ( nMonth > 12 ) )
1850 {
1851 // inacurrate around leap year, don't use days to calculate,
1852 // just modify the months directory
1853 sal_Int16 nYearAdj = ( nMonth /12 ); // default to positive months inputed
1854 if ( nMonth <=0 )
1855 nYearAdj = ( ( nMonth -12 ) / 12 );
1856 aCurDate.SetYear( aCurDate.GetYear() + nYearAdj );
1857 }
1858
1859 // adjust day value,
1860 // e.g. 2000, 2, 0 = 2000, 1, 31 or the last day of the previous month
1861 // 2000, 1, 32 = 2000, 2, 1 or the first day of the following month
1862 if( ( nDay < 1 ) || ( nDay > aCurDate.GetDaysInMonth() ) )
1863 aCurDate += nDay - 1;
1864 else
1865 aCurDate.SetDay( nDay );
1866 }
1867
1868 long nDiffDays = GetDayDiff( aCurDate );
1869 rdRet = (double)nDiffDays;
1870 return sal_True;
1871 }
1872
1873 // Function to convert date to ISO 8601 date format
RTLFUNC(CDateToIso)1874 RTLFUNC(CDateToIso)
1875 {
1876 (void)pBasic;
1877 (void)bWrite;
1878
1879 if ( rPar.Count() == 2 )
1880 {
1881 double aDate = rPar.Get(1)->GetDate();
1882
1883 char Buffer[9];
1884 snprintf( Buffer, sizeof( Buffer ), "%04d%02d%02d",
1885 implGetDateYear( aDate ),
1886 implGetDateMonth( aDate ),
1887 implGetDateDay( aDate ) );
1888 String aRetStr = String::CreateFromAscii( Buffer );
1889 rPar.Get(0)->PutString( aRetStr );
1890 }
1891 else
1892 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1893 }
1894
1895 // Function to convert date from ISO 8601 date format
RTLFUNC(CDateFromIso)1896 RTLFUNC(CDateFromIso)
1897 {
1898 (void)pBasic;
1899 (void)bWrite;
1900
1901 if ( rPar.Count() == 2 )
1902 {
1903 String aStr = rPar.Get(1)->GetString();
1904 sal_Int16 iMonthStart = aStr.Len() - 4;
1905 String aYearStr = aStr.Copy( 0, iMonthStart );
1906 String aMonthStr = aStr.Copy( iMonthStart, 2 );
1907 String aDayStr = aStr.Copy( iMonthStart+2, 2 );
1908
1909 double dDate;
1910 if( implDateSerial( (sal_Int16)aYearStr.ToInt32(),
1911 (sal_Int16)aMonthStr.ToInt32(), (sal_Int16)aDayStr.ToInt32(), dDate ) )
1912 {
1913 rPar.Get(0)->PutDate( dDate );
1914 }
1915 }
1916 else
1917 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1918 }
1919
RTLFUNC(DateSerial)1920 RTLFUNC(DateSerial)
1921 {
1922 (void)pBasic;
1923 (void)bWrite;
1924
1925 if ( rPar.Count() < 4 )
1926 {
1927 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1928 return;
1929 }
1930 sal_Int16 nYear = rPar.Get(1)->GetInteger();
1931 sal_Int16 nMonth = rPar.Get(2)->GetInteger();
1932 sal_Int16 nDay = rPar.Get(3)->GetInteger();
1933
1934 double dDate;
1935 if( implDateSerial( nYear, nMonth, nDay, dDate ) )
1936 rPar.Get(0)->PutDate( dDate );
1937 }
1938
RTLFUNC(TimeSerial)1939 RTLFUNC(TimeSerial)
1940 {
1941 (void)pBasic;
1942 (void)bWrite;
1943
1944 if ( rPar.Count() < 4 )
1945 {
1946 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1947 return;
1948 }
1949 sal_Int16 nHour = rPar.Get(1)->GetInteger();
1950 if ( nHour == 24 )
1951 nHour = 0; // Wegen UNO DateTimes, die bis 24 Uhr gehen
1952 sal_Int16 nMinute = rPar.Get(2)->GetInteger();
1953 sal_Int16 nSecond = rPar.Get(3)->GetInteger();
1954 if ((nHour < 0 || nHour > 23) ||
1955 (nMinute < 0 || nMinute > 59 ) ||
1956 (nSecond < 0 || nSecond > 59 ))
1957 {
1958 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1959 return;
1960 }
1961
1962 sal_Int32 nSeconds = nHour;
1963 nSeconds *= 3600;
1964 nSeconds += nMinute * 60;
1965 nSeconds += nSecond;
1966 double nDays = ((double)nSeconds) / (double)(86400.0);
1967 rPar.Get(0)->PutDate( nDays ); // JSM
1968 }
1969
RTLFUNC(DateValue)1970 RTLFUNC(DateValue)
1971 {
1972 (void)pBasic;
1973 (void)bWrite;
1974
1975 if ( rPar.Count() < 2 )
1976 StarBASIC::Error( SbERR_BAD_ARGUMENT );
1977 else
1978 {
1979 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
1980 SvNumberFormatter* pFormatter = NULL;
1981 if( pINST )
1982 pFormatter = pINST->GetNumberFormatter();
1983 else
1984 {
1985 sal_uInt32 n; // Dummy
1986 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n );
1987 }
1988
1989 sal_uInt32 nIndex;
1990 double fResult;
1991 String aStr( rPar.Get(1)->GetString() );
1992 sal_Bool bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, fResult );
1993 short nType = pFormatter->GetType( nIndex );
1994
1995 // DateValue("February 12, 1969") raises error if the system locale is not en_US
1996 // by using SbiInstance::GetNumberFormatter.
1997 // It seems that both locale number formatter and English number formatter
1998 // are supported in Visual Basic.
1999 LanguageType eLangType = GetpApp()->GetSettings().GetLanguage();
2000 if( !bSuccess && ( eLangType != LANGUAGE_ENGLISH_US ) )
2001 {
2002 // Create a new SvNumberFormatter by using LANGUAGE_ENGLISH to get the date value;
2003 com::sun::star::uno::Reference< com::sun::star::lang::XMultiServiceFactory >
2004 xFactory = comphelper::getProcessServiceFactory();
2005 SvNumberFormatter aFormatter( xFactory, LANGUAGE_ENGLISH_US );
2006 bSuccess = aFormatter.IsNumberFormat( aStr, nIndex, fResult );
2007 nType = aFormatter.GetType( nIndex );
2008 }
2009
2010 if(bSuccess && (nType==NUMBERFORMAT_DATE || nType==NUMBERFORMAT_DATETIME))
2011 {
2012 if ( nType == NUMBERFORMAT_DATETIME )
2013 {
2014 // Zeit abschneiden
2015 if ( fResult > 0.0 )
2016 fResult = floor( fResult );
2017 else
2018 fResult = ceil( fResult );
2019 }
2020 // fResult += 2.0; // Anpassung StarCalcFormatter
2021 rPar.Get(0)->PutDate( fResult ); // JSM
2022 }
2023 else
2024 StarBASIC::Error( SbERR_CONVERSION );
2025
2026 // #39629 pFormatter kann selbst angefordert sein
2027 if( !pINST )
2028 delete pFormatter;
2029 }
2030 }
2031
RTLFUNC(TimeValue)2032 RTLFUNC(TimeValue)
2033 {
2034 (void)pBasic;
2035 (void)bWrite;
2036
2037 if ( rPar.Count() < 2 )
2038 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2039 else
2040 {
2041 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
2042 SvNumberFormatter* pFormatter = NULL;
2043 if( pINST )
2044 pFormatter = pINST->GetNumberFormatter();
2045 else
2046 {
2047 sal_uInt32 n; // Dummy
2048 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n );
2049 }
2050
2051 sal_uInt32 nIndex;
2052 double fResult;
2053 sal_Bool bSuccess = pFormatter->IsNumberFormat( rPar.Get(1)->GetString(),
2054 nIndex, fResult );
2055 short nType = pFormatter->GetType(nIndex);
2056 if(bSuccess && (nType==NUMBERFORMAT_TIME||nType==NUMBERFORMAT_DATETIME))
2057 {
2058 if ( nType == NUMBERFORMAT_DATETIME )
2059 // Tage abschneiden
2060 fResult = fmod( fResult, 1 );
2061 rPar.Get(0)->PutDate( fResult ); // JSM
2062 }
2063 else
2064 StarBASIC::Error( SbERR_CONVERSION );
2065
2066 // #39629 pFormatter kann selbst angefordert sein
2067 if( !pINST )
2068 delete pFormatter;
2069 }
2070 }
2071
RTLFUNC(Day)2072 RTLFUNC(Day)
2073 {
2074 (void)pBasic;
2075 (void)bWrite;
2076
2077 if ( rPar.Count() < 2 )
2078 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2079 else
2080 {
2081 SbxVariableRef pArg = rPar.Get( 1 );
2082 double aDate = pArg->GetDate();
2083
2084 sal_Int16 nDay = implGetDateDay( aDate );
2085 rPar.Get(0)->PutInteger( nDay );
2086 }
2087 }
2088
RTLFUNC(Year)2089 RTLFUNC(Year)
2090 {
2091 (void)pBasic;
2092 (void)bWrite;
2093
2094 if ( rPar.Count() < 2 )
2095 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2096 else
2097 {
2098 sal_Int16 nYear = implGetDateYear( rPar.Get(1)->GetDate() );
2099 rPar.Get(0)->PutInteger( nYear );
2100 }
2101 }
2102
implGetHour(double dDate)2103 sal_Int16 implGetHour( double dDate )
2104 {
2105 double nFrac = dDate - floor( dDate );
2106 nFrac *= 86400.0;
2107 sal_Int32 nSeconds = (sal_Int32)(nFrac + 0.5);
2108 sal_Int16 nHour = (sal_Int16)(nSeconds / 3600);
2109 return nHour;
2110 }
2111
RTLFUNC(Hour)2112 RTLFUNC(Hour)
2113 {
2114 (void)pBasic;
2115 (void)bWrite;
2116
2117 if ( rPar.Count() < 2 )
2118 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2119 else
2120 {
2121 double nArg = rPar.Get(1)->GetDate();
2122 sal_Int16 nHour = implGetHour( nArg );
2123 rPar.Get(0)->PutInteger( nHour );
2124 }
2125 }
2126
implGetMinute(double dDate)2127 sal_Int16 implGetMinute( double dDate )
2128 {
2129 double nFrac = dDate - floor( dDate );
2130 nFrac *= 86400.0;
2131 sal_Int32 nSeconds = (sal_Int32)(nFrac + 0.5);
2132 sal_Int16 nTemp = (sal_Int16)(nSeconds % 3600);
2133 sal_Int16 nMin = nTemp / 60;
2134 return nMin;
2135 }
2136
RTLFUNC(Minute)2137 RTLFUNC(Minute)
2138 {
2139 (void)pBasic;
2140 (void)bWrite;
2141
2142 if ( rPar.Count() < 2 )
2143 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2144 else
2145 {
2146 double nArg = rPar.Get(1)->GetDate();
2147 sal_Int16 nMin = implGetMinute( nArg );
2148 rPar.Get(0)->PutInteger( nMin );
2149 }
2150 }
2151
RTLFUNC(Month)2152 RTLFUNC(Month)
2153 {
2154 (void)pBasic;
2155 (void)bWrite;
2156
2157 if ( rPar.Count() < 2 )
2158 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2159 else
2160 {
2161 sal_Int16 nMonth = implGetDateMonth( rPar.Get(1)->GetDate() );
2162 rPar.Get(0)->PutInteger( nMonth );
2163 }
2164 }
2165
implGetSecond(double dDate)2166 sal_Int16 implGetSecond( double dDate )
2167 {
2168 double nFrac = dDate - floor( dDate );
2169 nFrac *= 86400.0;
2170 sal_Int32 nSeconds = (sal_Int32)(nFrac + 0.5);
2171 sal_Int16 nTemp = (sal_Int16)(nSeconds / 3600);
2172 nSeconds -= nTemp * 3600;
2173 nTemp = (sal_Int16)(nSeconds / 60);
2174 nSeconds -= nTemp * 60;
2175
2176 sal_Int16 nRet = (sal_Int16)nSeconds;
2177 return nRet;
2178 }
2179
RTLFUNC(Second)2180 RTLFUNC(Second)
2181 {
2182 (void)pBasic;
2183 (void)bWrite;
2184
2185 if ( rPar.Count() < 2 )
2186 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2187 else
2188 {
2189 double nArg = rPar.Get(1)->GetDate();
2190 sal_Int16 nSecond = implGetSecond( nArg );
2191 rPar.Get(0)->PutInteger( nSecond );
2192 }
2193 }
2194
Now_Impl()2195 double Now_Impl()
2196 {
2197 Date aDate;
2198 Time aTime;
2199 double aSerial = (double)GetDayDiff( aDate );
2200 long nSeconds = aTime.GetHour();
2201 nSeconds *= 3600;
2202 nSeconds += aTime.GetMin() * 60;
2203 nSeconds += aTime.GetSec();
2204 double nDays = ((double)nSeconds) / (double)(24.0*3600.0);
2205 aSerial += nDays;
2206 return aSerial;
2207 }
2208
2209 // Date Now(void)
2210
RTLFUNC(Now)2211 RTLFUNC(Now)
2212 {
2213 (void)pBasic;
2214 (void)bWrite;
2215 rPar.Get(0)->PutDate( Now_Impl() );
2216 }
2217
2218 // Date Time(void)
2219
RTLFUNC(Time)2220 RTLFUNC(Time)
2221 {
2222 (void)pBasic;
2223
2224 if ( !bWrite )
2225 {
2226 Time aTime;
2227 SbxVariable* pMeth = rPar.Get( 0 );
2228 String aRes;
2229 if( pMeth->IsFixed() )
2230 {
2231 // Time$: hh:mm:ss
2232 char buf[ 20 ];
2233 snprintf( buf, sizeof(buf), "%02d:%02d:%02d",
2234 aTime.GetHour(), aTime.GetMin(), aTime.GetSec() );
2235 aRes = String::CreateFromAscii( buf );
2236 }
2237 else
2238 {
2239 // Time: system dependent
2240 long nSeconds=aTime.GetHour();
2241 nSeconds *= 3600;
2242 nSeconds += aTime.GetMin() * 60;
2243 nSeconds += aTime.GetSec();
2244 double nDays = (double)nSeconds * ( 1.0 / (24.0*3600.0) );
2245 Color* pCol;
2246
2247 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
2248 SvNumberFormatter* pFormatter = NULL;
2249 sal_uInt32 nIndex;
2250 if( pINST )
2251 {
2252 pFormatter = pINST->GetNumberFormatter();
2253 nIndex = pINST->GetStdTimeIdx();
2254 }
2255 else
2256 {
2257 sal_uInt32 n; // Dummy
2258 SbiInstance::PrepareNumberFormatter( pFormatter, n, nIndex, n );
2259 }
2260
2261 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2262
2263 // #39629 pFormatter kann selbst angefordert sein
2264 if( !pINST )
2265 delete pFormatter;
2266 }
2267 pMeth->PutString( aRes );
2268 }
2269 else
2270 {
2271 StarBASIC::Error( SbERR_NOT_IMPLEMENTED );
2272 }
2273 }
2274
RTLFUNC(Timer)2275 RTLFUNC(Timer)
2276 {
2277 (void)pBasic;
2278 (void)bWrite;
2279
2280 Time aTime;
2281 long nSeconds = aTime.GetHour();
2282 nSeconds *= 3600;
2283 nSeconds += aTime.GetMin() * 60;
2284 nSeconds += aTime.GetSec();
2285 rPar.Get(0)->PutDate( (double)nSeconds );
2286 }
2287
2288
RTLFUNC(Date)2289 RTLFUNC(Date)
2290 {
2291 (void)pBasic;
2292 (void)bWrite;
2293
2294 if ( !bWrite )
2295 {
2296 Date aToday;
2297 double nDays = (double)GetDayDiff( aToday );
2298 SbxVariable* pMeth = rPar.Get( 0 );
2299 if( pMeth->IsString() )
2300 {
2301 String aRes;
2302 Color* pCol;
2303
2304 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
2305 SvNumberFormatter* pFormatter = NULL;
2306 sal_uInt32 nIndex;
2307 if( pINST )
2308 {
2309 pFormatter = pINST->GetNumberFormatter();
2310 nIndex = pINST->GetStdDateIdx();
2311 }
2312 else
2313 {
2314 sal_uInt32 n; // Dummy
2315 SbiInstance::PrepareNumberFormatter( pFormatter, nIndex, n, n );
2316 }
2317
2318 pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
2319 pMeth->PutString( aRes );
2320
2321 // #39629 pFormatter kann selbst angefordert sein
2322 if( !pINST )
2323 delete pFormatter;
2324 }
2325 else
2326 pMeth->PutDate( nDays );
2327 }
2328 else
2329 {
2330 StarBASIC::Error( SbERR_NOT_IMPLEMENTED );
2331 }
2332 }
2333
RTLFUNC(IsArray)2334 RTLFUNC(IsArray)
2335 {
2336 (void)pBasic;
2337 (void)bWrite;
2338
2339 if ( rPar.Count() < 2 )
2340 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2341 else
2342 rPar.Get(0)->PutBool((rPar.Get(1)->GetType() & SbxARRAY) ? sal_True : sal_False );
2343 }
2344
RTLFUNC(IsObject)2345 RTLFUNC(IsObject)
2346 {
2347 (void)pBasic;
2348 (void)bWrite;
2349
2350 if ( rPar.Count() < 2 )
2351 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2352 else
2353 {
2354 SbxVariable* pVar = rPar.Get(1);
2355 SbxBase* pObj = (SbxBase*)pVar->GetObject();
2356
2357 // #100385: GetObject can result in an error, so reset it
2358 SbxBase::ResetError();
2359
2360 SbUnoClass* pUnoClass;
2361 sal_Bool bObject;
2362 if( pObj && NULL != ( pUnoClass=PTR_CAST(SbUnoClass,pObj) ) )
2363 {
2364 bObject = pUnoClass->getUnoClass().is();
2365 }
2366 else
2367 {
2368 bObject = pVar->IsObject();
2369 }
2370 rPar.Get( 0 )->PutBool( bObject );
2371 }
2372 }
2373
RTLFUNC(IsDate)2374 RTLFUNC(IsDate)
2375 {
2376 (void)pBasic;
2377 (void)bWrite;
2378
2379 if ( rPar.Count() < 2 )
2380 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2381 else
2382 {
2383 // #46134 Nur String wird konvertiert, andere Typen ergeben sal_False
2384 SbxVariableRef xArg = rPar.Get( 1 );
2385 SbxDataType eType = xArg->GetType();
2386 sal_Bool bDate = sal_False;
2387
2388 if( eType == SbxDATE )
2389 {
2390 bDate = sal_True;
2391 }
2392 else if( eType == SbxSTRING )
2393 {
2394 // Error loeschen
2395 SbxError nPrevError = SbxBase::GetError();
2396 SbxBase::ResetError();
2397
2398 // Konvertierung des Parameters nach SbxDATE erzwingen
2399 xArg->SbxValue::GetDate();
2400
2401 // Bei Fehler ist es kein Date
2402 bDate = !SbxBase::IsError();
2403
2404 // Error-Situation wiederherstellen
2405 SbxBase::ResetError();
2406 SbxBase::SetError( nPrevError );
2407 }
2408 rPar.Get( 0 )->PutBool( bDate );
2409 }
2410 }
2411
RTLFUNC(IsEmpty)2412 RTLFUNC(IsEmpty)
2413 {
2414 (void)pBasic;
2415 (void)bWrite;
2416
2417 if ( rPar.Count() < 2 )
2418 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2419 else
2420 rPar.Get( 0 )->PutBool( rPar.Get(1)->IsEmpty() );
2421 }
2422
RTLFUNC(IsError)2423 RTLFUNC(IsError)
2424 {
2425 (void)pBasic;
2426 (void)bWrite;
2427
2428 if ( rPar.Count() < 2 )
2429 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2430 else
2431 rPar.Get( 0 )->PutBool( rPar.Get(1)->IsErr() );
2432 }
2433
RTLFUNC(IsNull)2434 RTLFUNC(IsNull)
2435 {
2436 (void)pBasic;
2437 (void)bWrite;
2438
2439 if ( rPar.Count() < 2 )
2440 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2441 else
2442 {
2443 // #51475 Wegen Uno-Objekten auch true liefern,
2444 // wenn der pObj-Wert NULL ist
2445 SbxVariableRef pArg = rPar.Get( 1 );
2446 sal_Bool bNull = rPar.Get(1)->IsNull();
2447 if( !bNull && pArg->GetType() == SbxOBJECT )
2448 {
2449 SbxBase* pObj = pArg->GetObject();
2450 if( !pObj )
2451 bNull = sal_True;
2452 }
2453 rPar.Get( 0 )->PutBool( bNull );
2454 }
2455 }
2456
RTLFUNC(IsNumeric)2457 RTLFUNC(IsNumeric)
2458 {
2459 (void)pBasic;
2460 (void)bWrite;
2461
2462 if ( rPar.Count() < 2 )
2463 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2464 else
2465 rPar.Get( 0 )->PutBool( rPar.Get( 1 )->IsNumericRTL() );
2466 }
2467
2468 // Das machen wir auf die billige Tour
2469
RTLFUNC(IsMissing)2470 RTLFUNC(IsMissing)
2471 {
2472 (void)pBasic;
2473 (void)bWrite;
2474
2475 if ( rPar.Count() < 2 )
2476 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2477 else
2478 // #57915 Missing wird durch Error angezeigt
2479 rPar.Get( 0 )->PutBool( rPar.Get(1)->IsErr() );
2480 }
2481
2482 // Dir( [Maske] [,Attrs] )
2483 // ToDo: Library-globaler Datenbereich fuer Dir-Objekt und Flags
2484
2485
getDirectoryPath(String aPathStr)2486 String getDirectoryPath( String aPathStr )
2487 {
2488 String aRetStr;
2489
2490 DirectoryItem aItem;
2491 FileBase::RC nRet = DirectoryItem::get( aPathStr, aItem );
2492 if( nRet == FileBase::E_None )
2493 {
2494 FileStatus aFileStatus( FileStatusMask_Type );
2495 nRet = aItem.getFileStatus( aFileStatus );
2496 if( nRet == FileBase::E_None )
2497 {
2498 FileStatus::Type aType = aFileStatus.getFileType();
2499 if( isFolder( aType ) )
2500 {
2501 aRetStr = aPathStr;
2502 }
2503 else if( aType == FileStatus::Link )
2504 {
2505 FileStatus aFileStatus2( FileStatusMask_LinkTargetURL );
2506 nRet = aItem.getFileStatus( aFileStatus2 );
2507 if( nRet == FileBase::E_None )
2508 aRetStr = getDirectoryPath( aFileStatus2.getLinkTargetURL() );
2509 }
2510 }
2511 }
2512 return aRetStr;
2513 }
2514
2515 // Function looks for wildcards, removes them and always returns the pure path
implSetupWildcard(const String & rFileParam,SbiRTLData * pRTLData)2516 String implSetupWildcard( const String& rFileParam, SbiRTLData* pRTLData )
2517 {
2518 static String aAsterisk = String::CreateFromAscii( "*" );
2519 static sal_Char cDelim1 = (sal_Char)'/';
2520 static sal_Char cDelim2 = (sal_Char)'\\';
2521 static sal_Char cWild1 = '*';
2522 static sal_Char cWild2 = '?';
2523
2524 delete pRTLData->pWildCard;
2525 pRTLData->pWildCard = NULL;
2526 pRTLData->sFullNameToBeChecked = String();
2527
2528 String aFileParam = rFileParam;
2529 xub_StrLen nLastWild = aFileParam.SearchBackward( cWild1 );
2530 if( nLastWild == STRING_NOTFOUND )
2531 nLastWild = aFileParam.SearchBackward( cWild2 );
2532 sal_Bool bHasWildcards = ( nLastWild != STRING_NOTFOUND );
2533
2534
2535 xub_StrLen nLastDelim = aFileParam.SearchBackward( cDelim1 );
2536 if( nLastDelim == STRING_NOTFOUND )
2537 nLastDelim = aFileParam.SearchBackward( cDelim2 );
2538
2539 if( bHasWildcards )
2540 {
2541 // Wildcards in path?
2542 if( nLastDelim != STRING_NOTFOUND && nLastDelim > nLastWild )
2543 return aFileParam;
2544 }
2545 else
2546 {
2547 String aPathStr = getFullPath( aFileParam );
2548 if( nLastDelim != aFileParam.Len() - 1 )
2549 pRTLData->sFullNameToBeChecked = aPathStr;
2550 return aPathStr;
2551 }
2552
2553 String aPureFileName;
2554 if( nLastDelim == STRING_NOTFOUND )
2555 {
2556 aPureFileName = aFileParam;
2557 aFileParam = String();
2558 }
2559 else
2560 {
2561 aPureFileName = aFileParam.Copy( nLastDelim + 1 );
2562 aFileParam = aFileParam.Copy( 0, nLastDelim );
2563 }
2564
2565 // Try again to get a valid URL/UNC-path with only the path
2566 String aPathStr = getFullPath( aFileParam );
2567 xub_StrLen nPureLen = aPureFileName.Len();
2568
2569 // Is there a pure file name left? Otherwise the path is
2570 // invalid anyway because it was not accepted by OSL before
2571 if( nPureLen && aPureFileName != aAsterisk )
2572 {
2573 pRTLData->pWildCard = new WildCard( aPureFileName );
2574 }
2575 return aPathStr;
2576 }
2577
implCheckWildcard(const String & rName,SbiRTLData * pRTLData)2578 inline sal_Bool implCheckWildcard( const String& rName, SbiRTLData* pRTLData )
2579 {
2580 sal_Bool bMatch = sal_True;
2581
2582 if( pRTLData->pWildCard )
2583 bMatch = pRTLData->pWildCard->Matches( rName );
2584 return bMatch;
2585 }
2586
2587
isRootDir(String aDirURLStr)2588 bool isRootDir( String aDirURLStr )
2589 {
2590 INetURLObject aDirURLObj( aDirURLStr );
2591 sal_Bool bRoot = sal_False;
2592
2593 // Check if it's a root directory
2594 sal_Int32 nCount = aDirURLObj.getSegmentCount();
2595
2596 // No segment means Unix root directory "file:///"
2597 if( nCount == 0 )
2598 {
2599 bRoot = sal_True;
2600 }
2601 // Exactly one segment needs further checking, because it
2602 // can be Unix "file:///foo/" -> no root
2603 // or Windows "file:///c:/" -> root
2604 else if( nCount == 1 )
2605 {
2606 ::rtl::OUString aSeg1 = aDirURLObj.getName( 0, sal_True,
2607 INetURLObject::DECODE_WITH_CHARSET );
2608 if( aSeg1.getStr()[1] == (sal_Unicode)':' )
2609 {
2610 bRoot = sal_True;
2611 }
2612 }
2613 // More than one segments can never be root
2614 // so bRoot remains sal_False
2615
2616 return bRoot;
2617 }
2618
RTLFUNC(Dir)2619 RTLFUNC(Dir)
2620 {
2621 (void)pBasic;
2622 (void)bWrite;
2623
2624 String aPath;
2625
2626 sal_uInt16 nParCount = rPar.Count();
2627 if( nParCount > 3 )
2628 StarBASIC::Error( SbERR_BAD_ARGUMENT );
2629 else
2630 {
2631 SbiRTLData* pRTLData = pINST->GetRTLData();
2632
2633 // #34645: Kann auch von der URL-Zeile ueber 'macro: Dir' aufgerufen werden
2634 // dann existiert kein pRTLData und die Methode muss verlassen werden
2635 if( !pRTLData )
2636 return;
2637
2638 // <-- UCB
2639 if( hasUno() )
2640 {
2641 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
2642 if( xSFI.is() )
2643 {
2644 if ( nParCount >= 2 )
2645 {
2646 String aFileParam = rPar.Get(1)->GetString();
2647
2648 String aFileURLStr = implSetupWildcard( aFileParam, pRTLData );
2649 if( pRTLData->sFullNameToBeChecked.Len() > 0 )
2650 {
2651 sal_Bool bExists = sal_False;
2652 try { bExists = xSFI->exists( aFileURLStr ); }
2653 catch( Exception & ) {}
2654
2655 String aNameOnlyStr;
2656 if( bExists )
2657 {
2658 INetURLObject aFileURL( aFileURLStr );
2659 aNameOnlyStr = aFileURL.getName( INetURLObject::LAST_SEGMENT,
2660 true, INetURLObject::DECODE_WITH_CHARSET );
2661 }
2662 rPar.Get(0)->PutString( aNameOnlyStr );
2663 return;
2664 }
2665
2666 try
2667 {
2668 String aDirURLStr;
2669 sal_Bool bFolder = xSFI->isFolder( aFileURLStr );
2670
2671 if( bFolder )
2672 {
2673 aDirURLStr = aFileURLStr;
2674 }
2675 else
2676 {
2677 String aEmptyStr;
2678 rPar.Get(0)->PutString( aEmptyStr );
2679 }
2680
2681 sal_uInt16 nFlags = 0;
2682 if ( nParCount > 2 )
2683 pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger();
2684 else
2685 pRTLData->nDirFlags = 0;
2686
2687 // Read directory
2688 sal_Bool bIncludeFolders = ((nFlags & Sb_ATTR_DIRECTORY) != 0);
2689 pRTLData->aDirSeq = xSFI->getFolderContents( aDirURLStr, bIncludeFolders );
2690 pRTLData->nCurDirPos = 0;
2691
2692 // #78651 Add "." and ".." directories for VB compatibility
2693 if( bIncludeFolders )
2694 {
2695 sal_Bool bRoot = isRootDir( aDirURLStr );
2696
2697 // If it's no root directory we flag the need for
2698 // the "." and ".." directories by the value -2
2699 // for the actual position. Later for -2 will be
2700 // returned "." and for -1 ".."
2701 if( !bRoot )
2702 {
2703 pRTLData->nCurDirPos = -2;
2704 }
2705 }
2706 }
2707 catch( Exception & )
2708 {
2709 //StarBASIC::Error( ERRCODE_IO_GENERAL );
2710 }
2711 }
2712
2713
2714 if( pRTLData->aDirSeq.getLength() > 0 )
2715 {
2716 sal_Bool bFolderFlag = ((pRTLData->nDirFlags & Sb_ATTR_DIRECTORY) != 0);
2717
2718 SbiInstance* pInst = pINST;
2719 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
2720 for( ;; )
2721 {
2722 if( pRTLData->nCurDirPos < 0 )
2723 {
2724 if( pRTLData->nCurDirPos == -2 )
2725 {
2726 aPath = ::rtl::OUString::createFromAscii( "." );
2727 }
2728 else if( pRTLData->nCurDirPos == -1 )
2729 {
2730 aPath = ::rtl::OUString::createFromAscii( ".." );
2731 }
2732 pRTLData->nCurDirPos++;
2733 }
2734 else if( pRTLData->nCurDirPos >= pRTLData->aDirSeq.getLength() )
2735 {
2736 pRTLData->aDirSeq.realloc( 0 );
2737 aPath.Erase();
2738 break;
2739 }
2740 else
2741 {
2742 ::rtl::OUString aFile = pRTLData->aDirSeq.getConstArray()[pRTLData->nCurDirPos++];
2743
2744 if( bCompatibility )
2745 {
2746 if( !bFolderFlag )
2747 {
2748 sal_Bool bFolder = xSFI->isFolder( aFile );
2749 if( bFolder )
2750 continue;
2751 }
2752 }
2753 else
2754 {
2755 // Only directories
2756 if( bFolderFlag )
2757 {
2758 sal_Bool bFolder = xSFI->isFolder( aFile );
2759 if( !bFolder )
2760 continue;
2761 }
2762 }
2763
2764 INetURLObject aURL( aFile );
2765 aPath = aURL.getName( INetURLObject::LAST_SEGMENT, sal_True,
2766 INetURLObject::DECODE_WITH_CHARSET );
2767 }
2768
2769 sal_Bool bMatch = implCheckWildcard( aPath, pRTLData );
2770 if( !bMatch )
2771 continue;
2772
2773 break;
2774 }
2775 }
2776 rPar.Get(0)->PutString( aPath );
2777 }
2778 }
2779 else
2780 // --> UCB
2781 {
2782 #ifdef _OLD_FILE_IMPL
2783 if ( nParCount >= 2 )
2784 {
2785 delete pRTLData->pDir;
2786 pRTLData->pDir = 0; // wg. Sonderbehandlung Sb_ATTR_VOLUME
2787 DirEntry aEntry( rPar.Get(1)->GetString() );
2788 FileStat aStat( aEntry );
2789 if(!aStat.GetError() && (aStat.GetKind() & FSYS_KIND_FILE))
2790 {
2791 // ah ja, ist nur ein dateiname
2792 // Pfad abschneiden (wg. VB4)
2793 rPar.Get(0)->PutString( aEntry.GetName() );
2794 return;
2795 }
2796 sal_uInt16 nFlags = 0;
2797 if ( nParCount > 2 )
2798 pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger();
2799 else
2800 pRTLData->nDirFlags = 0;
2801
2802 // Sb_ATTR_VOLUME wird getrennt gehandelt
2803 if( pRTLData->nDirFlags & Sb_ATTR_VOLUME )
2804 aPath = aEntry.GetVolume();
2805 else
2806 {
2807 // Die richtige Auswahl treffen
2808 sal_uInt16 nMode = FSYS_KIND_FILE;
2809 if( nFlags & Sb_ATTR_DIRECTORY )
2810 nMode |= FSYS_KIND_DIR;
2811 if( nFlags == Sb_ATTR_DIRECTORY )
2812 nMode = FSYS_KIND_DIR;
2813 pRTLData->pDir = new Dir( aEntry, (DirEntryKind) nMode );
2814 pRTLData->nCurDirPos = 0;
2815 }
2816 }
2817
2818 if( pRTLData->pDir )
2819 {
2820 for( ;; )
2821 {
2822 if( pRTLData->nCurDirPos >= pRTLData->pDir->Count() )
2823 {
2824 delete pRTLData->pDir;
2825 pRTLData->pDir = 0;
2826 aPath.Erase();
2827 break;
2828 }
2829 DirEntry aNextEntry=(*(pRTLData->pDir))[pRTLData->nCurDirPos++];
2830 aPath = aNextEntry.GetName(); //Full();
2831 break;
2832 }
2833 }
2834 rPar.Get(0)->PutString( aPath );
2835 #else
2836 // TODO: OSL
2837 if ( nParCount >= 2 )
2838 {
2839 String aFileParam = rPar.Get(1)->GetString();
2840
2841 String aDirURL = implSetupWildcard( aFileParam, pRTLData );
2842
2843 sal_uInt16 nFlags = 0;
2844 if ( nParCount > 2 )
2845 pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger();
2846 else
2847 pRTLData->nDirFlags = 0;
2848
2849 // Read directory
2850 sal_Bool bIncludeFolders = ((nFlags & Sb_ATTR_DIRECTORY) != 0);
2851 pRTLData->pDir = new Directory( aDirURL );
2852 FileBase::RC nRet = pRTLData->pDir->open();
2853 if( nRet != FileBase::E_None )
2854 {
2855 delete pRTLData->pDir;
2856 pRTLData->pDir = NULL;
2857 rPar.Get(0)->PutString( String() );
2858 return;
2859 }
2860
2861 // #86950 Add "." and ".." directories for VB compatibility
2862 pRTLData->nCurDirPos = 0;
2863 if( bIncludeFolders )
2864 {
2865 sal_Bool bRoot = isRootDir( aDirURL );
2866
2867 // If it's no root directory we flag the need for
2868 // the "." and ".." directories by the value -2
2869 // for the actual position. Later for -2 will be
2870 // returned "." and for -1 ".."
2871 if( !bRoot )
2872 {
2873 pRTLData->nCurDirPos = -2;
2874 }
2875 }
2876
2877 }
2878
2879 if( pRTLData->pDir )
2880 {
2881 sal_Bool bFolderFlag = ((pRTLData->nDirFlags & Sb_ATTR_DIRECTORY) != 0);
2882 for( ;; )
2883 {
2884 if( pRTLData->nCurDirPos < 0 )
2885 {
2886 if( pRTLData->nCurDirPos == -2 )
2887 {
2888 aPath = ::rtl::OUString::createFromAscii( "." );
2889 }
2890 else if( pRTLData->nCurDirPos == -1 )
2891 {
2892 aPath = ::rtl::OUString::createFromAscii( ".." );
2893 }
2894 pRTLData->nCurDirPos++;
2895 }
2896 else
2897 {
2898 DirectoryItem aItem;
2899 FileBase::RC nRet = pRTLData->pDir->getNextItem( aItem );
2900 if( nRet != FileBase::E_None )
2901 {
2902 delete pRTLData->pDir;
2903 pRTLData->pDir = NULL;
2904 aPath.Erase();
2905 break;
2906 }
2907
2908 // Handle flags
2909 FileStatus aFileStatus( FileStatusMask_Type | FileStatusMask_FileName );
2910 nRet = aItem.getFileStatus( aFileStatus );
2911
2912 // Only directories?
2913 if( bFolderFlag )
2914 {
2915 FileStatus::Type aType = aFileStatus.getFileType();
2916 sal_Bool bFolder = isFolder( aType );
2917 if( !bFolder )
2918 continue;
2919 }
2920
2921 aPath = aFileStatus.getFileName();
2922 }
2923
2924 sal_Bool bMatch = implCheckWildcard( aPath, pRTLData );
2925 if( !bMatch )
2926 continue;
2927
2928 break;
2929 }
2930 }
2931 rPar.Get(0)->PutString( aPath );
2932 #endif
2933 }
2934 }
2935 }
2936
2937
RTLFUNC(GetAttr)2938 RTLFUNC(GetAttr)
2939 {
2940 (void)pBasic;
2941 (void)bWrite;
2942
2943 if ( rPar.Count() == 2 )
2944 {
2945 sal_Int16 nFlags = 0;
2946
2947 // In Windows, We want to use Windows API to get the file attributes
2948 // for VBA interoperability.
2949 #if defined( WNT )
2950 if( SbiRuntime::isVBAEnabled() )
2951 {
2952 DirEntry aEntry( rPar.Get(1)->GetString() );
2953 aEntry.ToAbs();
2954
2955 // #57064 Bei virtuellen URLs den Real-Path extrahieren
2956 ByteString aByteStrFullPath( aEntry.GetFull(), gsl_getSystemTextEncoding() );
2957 DWORD nRealFlags = GetFileAttributes (aByteStrFullPath.GetBuffer());
2958 if (nRealFlags != 0xffffffff)
2959 {
2960 if (nRealFlags == FILE_ATTRIBUTE_NORMAL)
2961 nRealFlags = 0;
2962 nFlags = (sal_Int16) (nRealFlags);
2963 }
2964 else
2965 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
2966
2967 rPar.Get(0)->PutInteger( nFlags );
2968
2969 return;
2970 }
2971 #endif
2972
2973 // <-- UCB
2974 if( hasUno() )
2975 {
2976 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
2977 if( xSFI.is() )
2978 {
2979 try
2980 {
2981 String aPath = getFullPath( rPar.Get(1)->GetString() );
2982 sal_Bool bExists = sal_False;
2983 try { bExists = xSFI->exists( aPath ); }
2984 catch( Exception & ) {}
2985 if( !bExists )
2986 {
2987 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
2988 return;
2989 }
2990
2991 sal_Bool bReadOnly = xSFI->isReadOnly( aPath );
2992 sal_Bool bHidden = xSFI->isHidden( aPath );
2993 sal_Bool bDirectory = xSFI->isFolder( aPath );
2994 if( bReadOnly )
2995 nFlags |= 0x0001; // ATTR_READONLY
2996 if( bHidden )
2997 nFlags |= 0x0002; // ATTR_HIDDEN
2998 if( bDirectory )
2999 nFlags |= 0x0010; // ATTR_DIRECTORY
3000 }
3001 catch( Exception & )
3002 {
3003 StarBASIC::Error( ERRCODE_IO_GENERAL );
3004 }
3005 }
3006 }
3007 else
3008 // --> UCB
3009 {
3010 DirectoryItem aItem;
3011 FileBase::RC nRet = DirectoryItem::get( getFullPathUNC( rPar.Get(1)->GetString() ), aItem );
3012 FileStatus aFileStatus( FileStatusMask_Attributes | FileStatusMask_Type );
3013 nRet = aItem.getFileStatus( aFileStatus );
3014 sal_uInt64 nAttributes = aFileStatus.getAttributes();
3015 sal_Bool bReadOnly = (nAttributes & Attribute_ReadOnly) != 0;
3016
3017 FileStatus::Type aType = aFileStatus.getFileType();
3018 sal_Bool bDirectory = isFolder( aType );
3019 if( bReadOnly )
3020 nFlags |= 0x0001; // ATTR_READONLY
3021 if( bDirectory )
3022 nFlags |= 0x0010; // ATTR_DIRECTORY
3023 }
3024 rPar.Get(0)->PutInteger( nFlags );
3025 }
3026 else
3027 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3028 }
3029
3030
RTLFUNC(FileDateTime)3031 RTLFUNC(FileDateTime)
3032 {
3033 (void)pBasic;
3034 (void)bWrite;
3035
3036 if ( rPar.Count() != 2 )
3037 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3038 else
3039 {
3040 // <-- UCB
3041 String aPath = rPar.Get(1)->GetString();
3042 Time aTime;
3043 Date aDate;
3044 if( hasUno() )
3045 {
3046 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
3047 if( xSFI.is() )
3048 {
3049 try
3050 {
3051 com::sun::star::util::DateTime aUnoDT = xSFI->getDateTimeModified( aPath );
3052 aTime = Time( aUnoDT.Hours, aUnoDT.Minutes, aUnoDT.Seconds, aUnoDT.HundredthSeconds );
3053 aDate = Date( aUnoDT.Day, aUnoDT.Month, aUnoDT.Year );
3054 }
3055 catch( Exception & )
3056 {
3057 StarBASIC::Error( ERRCODE_IO_GENERAL );
3058 }
3059 }
3060 }
3061 else
3062 // --> UCB
3063 {
3064 #ifdef _OLD_FILE_IMPL
3065 DirEntry aEntry( aPath );
3066 FileStat aStat( aEntry );
3067 aTime = Time( aStat.TimeModified() );
3068 aDate = Date( aStat.DateModified() );
3069 #else
3070 DirectoryItem aItem;
3071 FileBase::RC nRet = DirectoryItem::get( getFullPathUNC( aPath ), aItem );
3072 FileStatus aFileStatus( FileStatusMask_ModifyTime );
3073 nRet = aItem.getFileStatus( aFileStatus );
3074 TimeValue aTimeVal = aFileStatus.getModifyTime();
3075 oslDateTime aDT;
3076 osl_getDateTimeFromTimeValue( &aTimeVal, &aDT );
3077
3078 aTime = Time( aDT.Hours, aDT.Minutes, aDT.Seconds, 10000000*aDT.NanoSeconds );
3079 aDate = Date( aDT.Day, aDT.Month, aDT.Year );
3080 #endif
3081 }
3082
3083 double fSerial = (double)GetDayDiff( aDate );
3084 long nSeconds = aTime.GetHour();
3085 nSeconds *= 3600;
3086 nSeconds += aTime.GetMin() * 60;
3087 nSeconds += aTime.GetSec();
3088 double nDays = ((double)nSeconds) / (double)(24.0*3600.0);
3089 fSerial += nDays;
3090
3091 Color* pCol;
3092
3093 // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden
3094 SvNumberFormatter* pFormatter = NULL;
3095 sal_uInt32 nIndex;
3096 if( pINST )
3097 {
3098 pFormatter = pINST->GetNumberFormatter();
3099 nIndex = pINST->GetStdDateTimeIdx();
3100 }
3101 else
3102 {
3103 sal_uInt32 n; // Dummy
3104 SbiInstance::PrepareNumberFormatter( pFormatter, n, n, nIndex );
3105 }
3106
3107 String aRes;
3108 pFormatter->GetOutputString( fSerial, nIndex, aRes, &pCol );
3109 rPar.Get(0)->PutString( aRes );
3110
3111 // #39629 pFormatter kann selbst angefordert sein
3112 if( !pINST )
3113 delete pFormatter;
3114 }
3115 }
3116
3117
RTLFUNC(EOF)3118 RTLFUNC(EOF)
3119 {
3120 (void)pBasic;
3121 (void)bWrite;
3122
3123 // AB 08/16/2000: No changes for UCB
3124 if ( rPar.Count() != 2 )
3125 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3126 else
3127 {
3128 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3129 // nChannel--; // macht MD beim Oeffnen auch nicht
3130 SbiIoSystem* pIO = pINST->GetIoSystem();
3131 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3132 if ( !pSbStrm )
3133 {
3134 StarBASIC::Error( SbERR_BAD_CHANNEL );
3135 return;
3136 }
3137 sal_Bool bIsEof;
3138 SvStream* pSvStrm = pSbStrm->GetStrm();
3139 if ( pSbStrm->IsText() )
3140 {
3141 char cBla;
3142 (*pSvStrm) >> cBla; // koennen wir noch ein Zeichen lesen
3143 bIsEof = pSvStrm->IsEof();
3144 if ( !bIsEof )
3145 pSvStrm->SeekRel( -1 );
3146 }
3147 else
3148 bIsEof = pSvStrm->IsEof(); // fuer binaerdateien!
3149 rPar.Get(0)->PutBool( bIsEof );
3150 }
3151 }
3152
RTLFUNC(FileAttr)3153 RTLFUNC(FileAttr)
3154 {
3155 (void)pBasic;
3156 (void)bWrite;
3157
3158 // AB 08/16/2000: No changes for UCB
3159
3160 // #57064 Obwohl diese Funktion nicht mit DirEntry arbeitet, ist sie von
3161 // der Anpassung an virtuelle URLs nich betroffen, da sie nur auf bereits
3162 // geoeffneten Dateien arbeitet und der Name hier keine Rolle spielt.
3163
3164 if ( rPar.Count() != 3 )
3165 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3166 else
3167 {
3168 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3169 // nChannel--;
3170 SbiIoSystem* pIO = pINST->GetIoSystem();
3171 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3172 if ( !pSbStrm )
3173 {
3174 StarBASIC::Error( SbERR_BAD_CHANNEL );
3175 return;
3176 }
3177 sal_Int16 nRet;
3178 if ( rPar.Get(2)->GetInteger() == 1 )
3179 nRet = (sal_Int16)(pSbStrm->GetMode());
3180 else
3181 nRet = 0; // System file handle not supported
3182
3183 rPar.Get(0)->PutInteger( nRet );
3184 }
3185 }
RTLFUNC(Loc)3186 RTLFUNC(Loc)
3187 {
3188 (void)pBasic;
3189 (void)bWrite;
3190
3191 // AB 08/16/2000: No changes for UCB
3192 if ( rPar.Count() != 2 )
3193 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3194 else
3195 {
3196 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3197 SbiIoSystem* pIO = pINST->GetIoSystem();
3198 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3199 if ( !pSbStrm )
3200 {
3201 StarBASIC::Error( SbERR_BAD_CHANNEL );
3202 return;
3203 }
3204 SvStream* pSvStrm = pSbStrm->GetStrm();
3205 sal_uIntPtr nPos;
3206 if( pSbStrm->IsRandom())
3207 {
3208 short nBlockLen = pSbStrm->GetBlockLen();
3209 nPos = nBlockLen ? (pSvStrm->Tell() / nBlockLen) : 0;
3210 nPos++; // Blockpositionen beginnen bei 1
3211 }
3212 else if ( pSbStrm->IsText() )
3213 nPos = pSbStrm->GetLine();
3214 else if( pSbStrm->IsBinary() )
3215 nPos = pSvStrm->Tell();
3216 else if ( pSbStrm->IsSeq() )
3217 nPos = ( pSvStrm->Tell()+1 ) / 128;
3218 else
3219 nPos = pSvStrm->Tell();
3220 rPar.Get(0)->PutLong( (sal_Int32)nPos );
3221 }
3222 }
3223
RTLFUNC(Lof)3224 RTLFUNC(Lof)
3225 {
3226 (void)pBasic;
3227 (void)bWrite;
3228
3229 // AB 08/16/2000: No changes for UCB
3230 if ( rPar.Count() != 2 )
3231 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3232 else
3233 {
3234 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3235 SbiIoSystem* pIO = pINST->GetIoSystem();
3236 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3237 if ( !pSbStrm )
3238 {
3239 StarBASIC::Error( SbERR_BAD_CHANNEL );
3240 return;
3241 }
3242 SvStream* pSvStrm = pSbStrm->GetStrm();
3243 sal_uIntPtr nOldPos = pSvStrm->Tell();
3244 sal_uIntPtr nLen = pSvStrm->Seek( STREAM_SEEK_TO_END );
3245 pSvStrm->Seek( nOldPos );
3246 rPar.Get(0)->PutLong( (sal_Int32)nLen );
3247 }
3248 }
3249
3250
RTLFUNC(Seek)3251 RTLFUNC(Seek)
3252 {
3253 (void)pBasic;
3254 (void)bWrite;
3255
3256 // AB 08/16/2000: No changes for UCB
3257 int nArgs = (int)rPar.Count();
3258 if ( nArgs < 2 || nArgs > 3 )
3259 {
3260 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3261 return;
3262 }
3263 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3264 // nChannel--;
3265 SbiIoSystem* pIO = pINST->GetIoSystem();
3266 SbiStream* pSbStrm = pIO->GetStream( nChannel );
3267 if ( !pSbStrm )
3268 {
3269 StarBASIC::Error( SbERR_BAD_CHANNEL );
3270 return;
3271 }
3272 SvStream* pStrm = pSbStrm->GetStrm();
3273
3274 if ( nArgs == 2 ) // Seek-Function
3275 {
3276 sal_uIntPtr nPos = pStrm->Tell();
3277 if( pSbStrm->IsRandom() )
3278 nPos = nPos / pSbStrm->GetBlockLen();
3279 nPos++; // Basic zaehlt ab 1
3280 rPar.Get(0)->PutLong( (sal_Int32)nPos );
3281 }
3282 else // Seek-Statement
3283 {
3284 sal_Int32 nPos = rPar.Get(2)->GetLong();
3285 if ( nPos < 1 )
3286 {
3287 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3288 return;
3289 }
3290 nPos--; // Basic zaehlt ab 1, SvStreams zaehlen ab 0
3291 pSbStrm->SetExpandOnWriteTo( 0 );
3292 if ( pSbStrm->IsRandom() )
3293 nPos *= pSbStrm->GetBlockLen();
3294 pStrm->Seek( (sal_uIntPtr)nPos );
3295 pSbStrm->SetExpandOnWriteTo( nPos );
3296 }
3297 }
3298
RTLFUNC(Format)3299 RTLFUNC(Format)
3300 {
3301 (void)pBasic;
3302 (void)bWrite;
3303
3304 sal_uInt16 nArgCount = (sal_uInt16)rPar.Count();
3305 if ( nArgCount < 2 || nArgCount > 3 )
3306 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3307 else
3308 {
3309 String aResult;
3310 if( nArgCount == 2 )
3311 rPar.Get(1)->Format( aResult );
3312 else
3313 {
3314 String aFmt( rPar.Get(2)->GetString() );
3315 rPar.Get(1)->Format( aResult, &aFmt );
3316 }
3317 rPar.Get(0)->PutString( aResult );
3318 }
3319 }
3320
RTLFUNC(Randomize)3321 RTLFUNC(Randomize)
3322 {
3323 (void)pBasic;
3324 (void)bWrite;
3325
3326 if ( rPar.Count() > 2 )
3327 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3328 sal_Int16 nSeed;
3329 if( rPar.Count() == 2 )
3330 nSeed = (sal_Int16)rPar.Get(1)->GetInteger();
3331 else
3332 nSeed = (sal_Int16)rand();
3333 srand( nSeed );
3334 }
3335
RTLFUNC(Rnd)3336 RTLFUNC(Rnd)
3337 {
3338 (void)pBasic;
3339 (void)bWrite;
3340
3341 if ( rPar.Count() > 2 )
3342 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3343 else
3344 {
3345 double nRand = (double)rand();
3346 nRand = ( nRand / (double)RAND_MAX );
3347 rPar.Get(0)->PutDouble( nRand );
3348 }
3349 }
3350
3351
3352 //
3353 // Syntax: Shell("Path",[ Window-Style,[ "Params", [ bSync = sal_False ]]])
3354 //
3355 // WindowStyles (VBA-kompatibel):
3356 // 2 == Minimized
3357 // 3 == Maximized
3358 // 10 == Full-Screen (Textmodus-Anwendungen OS/2, WIN95, WNT)
3359 //
3360 // !!!HACK der WindowStyle wird im Creator an Application::StartApp
3361 // uebergeben. Format: "xxxx2"
3362 //
3363
3364
RTLFUNC(Shell)3365 RTLFUNC(Shell)
3366 {
3367 (void)pBasic;
3368 (void)bWrite;
3369
3370 // No shell command for "virtual" portal users
3371 if( needSecurityRestrictions() )
3372 {
3373 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3374 return;
3375 }
3376
3377 sal_uIntPtr nArgCount = rPar.Count();
3378 if ( nArgCount < 2 || nArgCount > 5 )
3379 {
3380 rPar.Get(0)->PutLong(0);
3381 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3382 }
3383 else
3384 {
3385 sal_uInt16 nOptions = vos::OProcess::TOption_SearchPath|
3386 vos::OProcess::TOption_Detached;
3387 String aCmdLine = rPar.Get(1)->GetString();
3388 // Zusaetzliche Parameter anhaengen, es muss eh alles geparsed werden
3389 if( nArgCount >= 4 )
3390 {
3391 aCmdLine.AppendAscii( " " );
3392 aCmdLine += rPar.Get(3)->GetString();
3393 }
3394 else if( !aCmdLine.Len() )
3395 {
3396 // Spezial-Behandlung (leere Liste) vermeiden
3397 aCmdLine.AppendAscii( " " );
3398 }
3399 sal_uInt16 nLen = aCmdLine.Len();
3400
3401 // #55735 Wenn Parameter dabei sind, muessen die abgetrennt werden
3402 // #72471 Auch die einzelnen Parameter trennen
3403 std::list<String> aTokenList;
3404 String aToken;
3405 sal_uInt16 i = 0;
3406 sal_Unicode c;
3407 while( i < nLen )
3408 {
3409 // Spaces weg
3410 for ( ;; ++i )
3411 {
3412 c = aCmdLine.GetBuffer()[ i ];
3413 if ( c != ' ' && c != '\t' )
3414 break;
3415 }
3416
3417 if( c == '\"' || c == '\'' )
3418 {
3419 sal_uInt16 iFoundPos = aCmdLine.Search( c, i + 1 );
3420
3421 // Wenn nichts gefunden wurde, Rest kopieren
3422 if( iFoundPos == STRING_NOTFOUND )
3423 {
3424 aToken = aCmdLine.Copy( i, STRING_LEN );
3425 i = nLen;
3426 }
3427 else
3428 {
3429 aToken = aCmdLine.Copy( i + 1, (iFoundPos - i - 1) );
3430 i = iFoundPos + 1;
3431 }
3432 }
3433 else
3434 {
3435 sal_uInt16 iFoundSpacePos = aCmdLine.Search( ' ', i );
3436 sal_uInt16 iFoundTabPos = aCmdLine.Search( '\t', i );
3437 sal_uInt16 iFoundPos = Min( iFoundSpacePos, iFoundTabPos );
3438
3439 // Wenn nichts gefunden wurde, Rest kopieren
3440 if( iFoundPos == STRING_NOTFOUND )
3441 {
3442 aToken = aCmdLine.Copy( i, STRING_LEN );
3443 i = nLen;
3444 }
3445 else
3446 {
3447 aToken = aCmdLine.Copy( i, (iFoundPos - i) );
3448 i = iFoundPos;
3449 }
3450 }
3451
3452 // In die Liste uebernehmen
3453 aTokenList.push_back( aToken );
3454 }
3455 // #55735 / #72471 Ende
3456
3457 sal_Int16 nWinStyle = 0;
3458 if( nArgCount >= 3 )
3459 {
3460 nWinStyle = rPar.Get(2)->GetInteger();
3461 switch( nWinStyle )
3462 {
3463 case 2:
3464 nOptions |= vos::OProcess::TOption_Minimized;
3465 break;
3466 case 3:
3467 nOptions |= vos::OProcess::TOption_Maximized;
3468 break;
3469 case 10:
3470 nOptions |= vos::OProcess::TOption_FullScreen;
3471 break;
3472 }
3473
3474 sal_Bool bSync = sal_False;
3475 if( nArgCount >= 5 )
3476 bSync = rPar.Get(4)->GetBool();
3477 if( bSync )
3478 nOptions |= vos::OProcess::TOption_Wait;
3479 }
3480 vos::OProcess::TProcessOption eOptions =
3481 (vos::OProcess::TProcessOption)nOptions;
3482
3483
3484 // #72471 Parameter aufbereiten
3485 std::list<String>::const_iterator iter = aTokenList.begin();
3486 const String& rStr = *iter;
3487 ::rtl::OUString aOUStrProg( rStr.GetBuffer(), rStr.Len() );
3488 String aOUStrProgUNC = getFullPathUNC( aOUStrProg );
3489
3490 iter++;
3491
3492 sal_uInt16 nParamCount = sal::static_int_cast< sal_uInt16 >(
3493 aTokenList.size() - 1 );
3494 ::rtl::OUString* pArgumentList = NULL;
3495 //const char** pParamList = NULL;
3496 if( nParamCount )
3497 {
3498 pArgumentList = new ::rtl::OUString[ nParamCount ];
3499 //pParamList = new const char*[ nParamCount ];
3500 sal_uInt16 iList = 0;
3501 while( iter != aTokenList.end() )
3502 {
3503 const String& rParamStr = (*iter);
3504 pArgumentList[iList++] = ::rtl::OUString( rParamStr.GetBuffer(), rParamStr.Len() );
3505 //pParamList[iList++] = (*iter).GetStr();
3506 iter++;
3507 }
3508 }
3509
3510 //const char* pParams = aParams.Len() ? aParams.GetStr() : 0;
3511 vos::OProcess* pApp;
3512 pApp = new vos::OProcess( aOUStrProgUNC );
3513 sal_Bool bSucc;
3514 if( nParamCount == 0 )
3515 {
3516 bSucc = pApp->execute( eOptions ) == vos::OProcess::E_None;
3517 }
3518 else
3519 {
3520 vos::OArgumentList aArgList( pArgumentList, nParamCount );
3521 bSucc = pApp->execute( eOptions, aArgList ) == vos::OProcess::E_None;
3522 }
3523
3524 /*
3525 if( nParamCount == 0 )
3526 pApp = new vos::OProcess( pProg );
3527 else
3528 pApp = new vos::OProcess( pProg, pParamList, nParamCount );
3529 sal_Bool bSucc = pApp->execute( eOptions ) == vos::OProcess::E_None;
3530 */
3531
3532 delete pApp;
3533 delete[] pArgumentList;
3534 if( !bSucc )
3535 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
3536 else
3537 rPar.Get(0)->PutLong( 0 );
3538 }
3539 }
3540
RTLFUNC(VarType)3541 RTLFUNC(VarType)
3542 {
3543 (void)pBasic;
3544 (void)bWrite;
3545
3546 if ( rPar.Count() != 2 )
3547 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3548 else
3549 {
3550 SbxDataType eType = rPar.Get(1)->GetType();
3551 rPar.Get(0)->PutInteger( (sal_Int16)eType );
3552 }
3553 }
3554
3555 // Exported function
getBasicTypeName(SbxDataType eType)3556 String getBasicTypeName( SbxDataType eType )
3557 {
3558 static const char* pTypeNames[] =
3559 {
3560 "Empty", // SbxEMPTY
3561 "Null", // SbxNULL
3562 "Integer", // SbxINTEGER
3563 "Long", // SbxLONG
3564 "Single", // SbxSINGLE
3565 "Double", // SbxDOUBLE
3566 "Currency", // SbxCURRENCY
3567 "Date", // SbxDATE
3568 "String", // SbxSTRING
3569 "Object", // SbxOBJECT
3570 "Error", // SbxERROR
3571 "Boolean", // SbxBOOL
3572 "Variant", // SbxVARIANT
3573 "DataObject", // SbxDATAOBJECT
3574 "Unknown Type", //
3575 "Unknown Type", //
3576 "Char", // SbxCHAR
3577 "Byte", // SbxBYTE
3578 "UShort", // SbxUSHORT
3579 "ULong", // SbxULONG
3580 "Long64", // SbxLONG64
3581 "ULong64", // SbxULONG64
3582 "Int", // SbxINT
3583 "UInt", // SbxUINT
3584 "Void", // SbxVOID
3585 "HResult", // SbxHRESULT
3586 "Pointer", // SbxPOINTER
3587 "DimArray", // SbxDIMARRAY
3588 "CArray", // SbxCARRAY
3589 "Userdef", // SbxUSERDEF
3590 "Lpstr", // SbxLPSTR
3591 "Lpwstr", // SbxLPWSTR
3592 "Unknown Type", // SbxCoreSTRING
3593 "WString", // SbxWSTRING
3594 "WChar", // SbxWCHAR
3595 "Int64", // SbxSALINT64
3596 "UInt64", // SbxSALUINT64
3597 "Decimal", // SbxDECIMAL
3598 };
3599
3600 int nPos = ((int)eType) & 0x0FFF;
3601 sal_uInt16 nTypeNameCount = sizeof( pTypeNames ) / sizeof( char* );
3602 if ( nPos < 0 || nPos >= nTypeNameCount )
3603 nPos = nTypeNameCount - 1;
3604 String aRetStr = String::CreateFromAscii( pTypeNames[nPos] );
3605 return aRetStr;
3606 }
3607
RTLFUNC(TypeName)3608 RTLFUNC(TypeName)
3609 {
3610 (void)pBasic;
3611 (void)bWrite;
3612
3613 if ( rPar.Count() != 2 )
3614 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3615 else
3616 {
3617 SbxDataType eType = rPar.Get(1)->GetType();
3618 sal_Bool bIsArray = ( ( eType & SbxARRAY ) != 0 );
3619 String aRetStr = getBasicTypeName( eType );
3620 if( bIsArray )
3621 aRetStr.AppendAscii( "()" );
3622 rPar.Get(0)->PutString( aRetStr );
3623 }
3624 }
3625
RTLFUNC(Len)3626 RTLFUNC(Len)
3627 {
3628 (void)pBasic;
3629 (void)bWrite;
3630
3631 if ( rPar.Count() != 2 )
3632 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3633 else
3634 {
3635 const String& rStr = rPar.Get(1)->GetString();
3636 rPar.Get(0)->PutLong( (sal_Int32)rStr.Len() );
3637 }
3638 }
3639
RTLFUNC(DDEInitiate)3640 RTLFUNC(DDEInitiate)
3641 {
3642 (void)pBasic;
3643 (void)bWrite;
3644
3645 // No DDE for "virtual" portal users
3646 if( needSecurityRestrictions() )
3647 {
3648 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3649 return;
3650 }
3651
3652 int nArgs = (int)rPar.Count();
3653 if ( nArgs != 3 )
3654 {
3655 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3656 return;
3657 }
3658 const String& rApp = rPar.Get(1)->GetString();
3659 const String& rTopic = rPar.Get(2)->GetString();
3660
3661 SbiDdeControl* pDDE = pINST->GetDdeControl();
3662 sal_Int16 nChannel;
3663 SbError nDdeErr = pDDE->Initiate( rApp, rTopic, nChannel );
3664 if( nDdeErr )
3665 StarBASIC::Error( nDdeErr );
3666 else
3667 rPar.Get(0)->PutInteger( nChannel );
3668 }
3669
RTLFUNC(DDETerminate)3670 RTLFUNC(DDETerminate)
3671 {
3672 (void)pBasic;
3673 (void)bWrite;
3674
3675 // No DDE for "virtual" portal users
3676 if( needSecurityRestrictions() )
3677 {
3678 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3679 return;
3680 }
3681
3682 rPar.Get(0)->PutEmpty();
3683 int nArgs = (int)rPar.Count();
3684 if ( nArgs != 2 )
3685 {
3686 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3687 return;
3688 }
3689 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3690 SbiDdeControl* pDDE = pINST->GetDdeControl();
3691 SbError nDdeErr = pDDE->Terminate( nChannel );
3692 if( nDdeErr )
3693 StarBASIC::Error( nDdeErr );
3694 }
3695
RTLFUNC(DDETerminateAll)3696 RTLFUNC(DDETerminateAll)
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 != 1 )
3711 {
3712 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3713 return;
3714 }
3715
3716 SbiDdeControl* pDDE = pINST->GetDdeControl();
3717 SbError nDdeErr = pDDE->TerminateAll();
3718 if( nDdeErr )
3719 StarBASIC::Error( nDdeErr );
3720
3721 }
3722
RTLFUNC(DDERequest)3723 RTLFUNC(DDERequest)
3724 {
3725 (void)pBasic;
3726 (void)bWrite;
3727
3728 // No DDE for "virtual" portal users
3729 if( needSecurityRestrictions() )
3730 {
3731 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3732 return;
3733 }
3734
3735 int nArgs = (int)rPar.Count();
3736 if ( nArgs != 3 )
3737 {
3738 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3739 return;
3740 }
3741 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3742 const String& rItem = rPar.Get(2)->GetString();
3743 SbiDdeControl* pDDE = pINST->GetDdeControl();
3744 String aResult;
3745 SbError nDdeErr = pDDE->Request( nChannel, rItem, aResult );
3746 if( nDdeErr )
3747 StarBASIC::Error( nDdeErr );
3748 else
3749 rPar.Get(0)->PutString( aResult );
3750 }
3751
RTLFUNC(DDEExecute)3752 RTLFUNC(DDEExecute)
3753 {
3754 (void)pBasic;
3755 (void)bWrite;
3756
3757 // No DDE for "virtual" portal users
3758 if( needSecurityRestrictions() )
3759 {
3760 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3761 return;
3762 }
3763
3764 rPar.Get(0)->PutEmpty();
3765 int nArgs = (int)rPar.Count();
3766 if ( nArgs != 3 )
3767 {
3768 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3769 return;
3770 }
3771 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3772 const String& rCommand = rPar.Get(2)->GetString();
3773 SbiDdeControl* pDDE = pINST->GetDdeControl();
3774 SbError nDdeErr = pDDE->Execute( nChannel, rCommand );
3775 if( nDdeErr )
3776 StarBASIC::Error( nDdeErr );
3777 }
3778
RTLFUNC(DDEPoke)3779 RTLFUNC(DDEPoke)
3780 {
3781 (void)pBasic;
3782 (void)bWrite;
3783
3784 // No DDE for "virtual" portal users
3785 if( needSecurityRestrictions() )
3786 {
3787 StarBASIC::Error(SbERR_NOT_IMPLEMENTED);
3788 return;
3789 }
3790
3791 rPar.Get(0)->PutEmpty();
3792 int nArgs = (int)rPar.Count();
3793 if ( nArgs != 4 )
3794 {
3795 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3796 return;
3797 }
3798 sal_Int16 nChannel = rPar.Get(1)->GetInteger();
3799 const String& rItem = rPar.Get(2)->GetString();
3800 const String& rData = rPar.Get(3)->GetString();
3801 SbiDdeControl* pDDE = pINST->GetDdeControl();
3802 SbError nDdeErr = pDDE->Poke( nChannel, rItem, rData );
3803 if( nDdeErr )
3804 StarBASIC::Error( nDdeErr );
3805 }
3806
3807
RTLFUNC(FreeFile)3808 RTLFUNC(FreeFile)
3809 {
3810 (void)pBasic;
3811 (void)bWrite;
3812
3813 if ( rPar.Count() != 1 )
3814 {
3815 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3816 return;
3817 }
3818 SbiIoSystem* pIO = pINST->GetIoSystem();
3819 short nChannel = 1;
3820 while( nChannel < CHANNELS )
3821 {
3822 SbiStream* pStrm = pIO->GetStream( nChannel );
3823 if( !pStrm )
3824 {
3825 rPar.Get(0)->PutInteger( nChannel );
3826 return;
3827 }
3828 nChannel++;
3829 }
3830 StarBASIC::Error( SbERR_TOO_MANY_FILES );
3831 }
3832
RTLFUNC(LBound)3833 RTLFUNC(LBound)
3834 {
3835 (void)pBasic;
3836 (void)bWrite;
3837
3838 sal_uInt16 nParCount = rPar.Count();
3839 if ( nParCount != 3 && nParCount != 2 )
3840 {
3841 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3842 return;
3843 }
3844 SbxBase* pParObj = rPar.Get(1)->GetObject();
3845 SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj);
3846 if( pArr )
3847 {
3848 sal_Int32 nLower, nUpper;
3849 short nDim = (nParCount == 3) ? (short)rPar.Get(2)->GetInteger() : 1;
3850 if( !pArr->GetDim32( nDim, nLower, nUpper ) )
3851 StarBASIC::Error( SbERR_OUT_OF_RANGE );
3852 else
3853 rPar.Get(0)->PutLong( nLower );
3854 }
3855 else
3856 StarBASIC::Error( SbERR_MUST_HAVE_DIMS );
3857 }
3858
RTLFUNC(UBound)3859 RTLFUNC(UBound)
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
3871 SbxBase* pParObj = rPar.Get(1)->GetObject();
3872 SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj);
3873 if( pArr )
3874 {
3875 sal_Int32 nLower, nUpper;
3876 short nDim = (nParCount == 3) ? (short)rPar.Get(2)->GetInteger() : 1;
3877 if( !pArr->GetDim32( nDim, nLower, nUpper ) )
3878 StarBASIC::Error( SbERR_OUT_OF_RANGE );
3879 else
3880 rPar.Get(0)->PutLong( nUpper );
3881 }
3882 else
3883 StarBASIC::Error( SbERR_MUST_HAVE_DIMS );
3884 }
3885
RTLFUNC(RGB)3886 RTLFUNC(RGB)
3887 {
3888 (void)pBasic;
3889 (void)bWrite;
3890
3891 if ( rPar.Count() != 4 )
3892 {
3893 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3894 return;
3895 }
3896
3897 sal_uIntPtr nRed = rPar.Get(1)->GetInteger() & 0xFF;
3898 sal_uIntPtr nGreen = rPar.Get(2)->GetInteger() & 0xFF;
3899 sal_uIntPtr nBlue = rPar.Get(3)->GetInteger() & 0xFF;
3900 sal_uIntPtr nRGB;
3901
3902 SbiInstance* pInst = pINST;
3903 bool bCompatibility = ( pInst && pInst->IsCompatibility() );
3904 if( bCompatibility )
3905 {
3906 nRGB = (nBlue << 16) | (nGreen << 8) | nRed;
3907 }
3908 else
3909 {
3910 nRGB = (nRed << 16) | (nGreen << 8) | nBlue;
3911 }
3912 rPar.Get(0)->PutLong( nRGB );
3913 }
3914
RTLFUNC(QBColor)3915 RTLFUNC(QBColor)
3916 {
3917 (void)pBasic;
3918 (void)bWrite;
3919
3920 static const sal_Int32 pRGB[] =
3921 {
3922 0x000000,
3923 0x800000,
3924 0x008000,
3925 0x808000,
3926 0x000080,
3927 0x800080,
3928 0x008080,
3929 0xC0C0C0,
3930 0x808080,
3931 0xFF0000,
3932 0x00FF00,
3933 0xFFFF00,
3934 0x0000FF,
3935 0xFF00FF,
3936 0x00FFFF,
3937 0xFFFFFF,
3938 };
3939
3940 if ( rPar.Count() != 2 )
3941 {
3942 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3943 return;
3944 }
3945
3946 sal_Int16 nCol = rPar.Get(1)->GetInteger();
3947 if( nCol < 0 || nCol > 15 )
3948 {
3949 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3950 return;
3951 }
3952 sal_Int32 nRGB = pRGB[ nCol ];
3953 rPar.Get(0)->PutLong( nRGB );
3954 }
3955
3956 // StrConv(string, conversion, LCID)
RTLFUNC(StrConv)3957 RTLFUNC(StrConv)
3958 {
3959 (void)pBasic;
3960 (void)bWrite;
3961
3962 sal_uIntPtr nArgCount = rPar.Count()-1;
3963 if( nArgCount < 2 || nArgCount > 3 )
3964 {
3965 StarBASIC::Error( SbERR_BAD_ARGUMENT );
3966 return;
3967 }
3968
3969 String aOldStr = rPar.Get(1)->GetString();
3970 sal_Int32 nConversion = rPar.Get(2)->GetLong();
3971
3972 sal_uInt16 nLanguage = LANGUAGE_SYSTEM;
3973 if( nArgCount == 3 )
3974 {
3975 // LCID not supported now
3976 //nLanguage = rPar.Get(3)->GetInteger();
3977 }
3978
3979 sal_uInt16 nOldLen = aOldStr.Len();
3980 if( nOldLen == 0 )
3981 {
3982 // null string,return
3983 rPar.Get(0)->PutString(aOldStr);
3984 return;
3985 }
3986
3987 sal_Int32 nType = 0;
3988 if ( (nConversion & 0x03) == 3 ) // vbProperCase
3989 {
3990 CharClass& rCharClass = GetCharClass();
3991 aOldStr = rCharClass.toTitle( aOldStr.ToLowerAscii(), 0, nOldLen );
3992 }
3993 else if ( (nConversion & 0x01) == 1 ) // vbUpperCase
3994 nType |= ::com::sun::star::i18n::TransliterationModules_LOWERCASE_UPPERCASE;
3995 else if ( (nConversion & 0x02) == 2 ) // vbLowerCase
3996 nType |= ::com::sun::star::i18n::TransliterationModules_UPPERCASE_LOWERCASE;
3997
3998 if ( (nConversion & 0x04) == 4 ) // vbWide
3999 nType |= ::com::sun::star::i18n::TransliterationModules_HALFWIDTH_FULLWIDTH;
4000 else if ( (nConversion & 0x08) == 8 ) // vbNarrow
4001 nType |= ::com::sun::star::i18n::TransliterationModules_FULLWIDTH_HALFWIDTH;
4002
4003 if ( (nConversion & 0x10) == 16) // vbKatakana
4004 nType |= ::com::sun::star::i18n::TransliterationModules_HIRAGANA_KATAKANA;
4005 else if ( (nConversion & 0x20) == 32 ) // vbHiragana
4006 nType |= ::com::sun::star::i18n::TransliterationModules_KATAKANA_HIRAGANA;
4007
4008 String aNewStr( aOldStr );
4009 if( nType != 0 )
4010 {
4011 com::sun::star::uno::Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory();
4012 ::utl::TransliterationWrapper aTransliterationWrapper( xSMgr,nType );
4013 com::sun::star::uno::Sequence<sal_Int32> aOffsets;
4014 aTransliterationWrapper.loadModuleIfNeeded( nLanguage );
4015 aNewStr = aTransliterationWrapper.transliterate( aOldStr, nLanguage, 0, nOldLen, &aOffsets );
4016 }
4017
4018 if ( (nConversion & 0x40) == 64 ) // vbUnicode
4019 {
4020 // convert the string to byte string, preserving unicode (2 bytes per character)
4021 sal_uInt16 nSize = aNewStr.Len()*2;
4022 const sal_Unicode* pSrc = aNewStr.GetBuffer();
4023 sal_Char* pChar = new sal_Char[nSize+1];
4024 for( sal_uInt16 i=0; i < nSize; i++ )
4025 {
4026 pChar[i] = static_cast< sal_Char >( i%2 ? ((*pSrc) >> 8) & 0xff : (*pSrc) & 0xff );
4027 if( i%2 )
4028 pSrc++;
4029 }
4030 pChar[nSize] = '\0';
4031 ::rtl::OString aOStr(pChar);
4032
4033 // there is no concept about default codepage in unix. so it is incorrectly in unix
4034 ::rtl::OUString aOUStr = ::rtl::OStringToOUString(aOStr, osl_getThreadTextEncoding());
4035 aNewStr = String(aOUStr);
4036 rPar.Get(0)->PutString( aNewStr );
4037 return;
4038 }
4039 else if ( (nConversion & 0x80) == 128 ) // vbFromUnicode
4040 {
4041 ::rtl::OUString aOUStr(aNewStr);
4042 // there is no concept about default codepage in unix. so it is incorrectly in unix
4043 ::rtl::OString aOStr = ::rtl::OUStringToOString(aNewStr,osl_getThreadTextEncoding());
4044 const sal_Char* pChar = aOStr.getStr();
4045 sal_uInt16 nArraySize = static_cast< sal_uInt16 >( aOStr.getLength() );
4046 SbxDimArray* pArray = new SbxDimArray(SbxBYTE);
4047 bool bIncIndex = (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() );
4048 if(nArraySize)
4049 {
4050 if( bIncIndex )
4051 pArray->AddDim( 1, nArraySize );
4052 else
4053 pArray->AddDim( 0, nArraySize-1 );
4054 }
4055 else
4056 {
4057 pArray->unoAddDim( 0, -1 );
4058 }
4059
4060 for( sal_uInt16 i=0; i< nArraySize; i++)
4061 {
4062 SbxVariable* pNew = new SbxVariable( SbxBYTE );
4063 pNew->PutByte(*pChar);
4064 pChar++;
4065 pNew->SetFlag( SBX_WRITE );
4066 short index = i;
4067 if( bIncIndex )
4068 ++index;
4069 pArray->Put( pNew, &index );
4070 }
4071
4072 SbxVariableRef refVar = rPar.Get(0);
4073 sal_uInt16 nFlags = refVar->GetFlags();
4074 refVar->ResetFlag( SBX_FIXED );
4075 refVar->PutObject( pArray );
4076 refVar->SetFlags( nFlags );
4077 refVar->SetParameters( NULL );
4078 return;
4079 }
4080
4081 rPar.Get(0)->PutString(aNewStr);
4082 }
4083
4084
RTLFUNC(Beep)4085 RTLFUNC(Beep)
4086 {
4087 (void)pBasic;
4088 (void)bWrite;
4089
4090 if ( rPar.Count() != 1 )
4091 {
4092 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4093 return;
4094 }
4095 Sound::Beep();
4096 }
4097
RTLFUNC(Load)4098 RTLFUNC(Load)
4099 {
4100 (void)pBasic;
4101 (void)bWrite;
4102
4103 if( rPar.Count() != 2 )
4104 {
4105 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4106 return;
4107 }
4108
4109 // Diesen Call einfach an das Object weiterreichen
4110 SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
4111 if ( pObj )
4112 {
4113 if( pObj->IsA( TYPE( SbUserFormModule ) ) )
4114 {
4115 ((SbUserFormModule*)pObj)->Load();
4116 }
4117 else if( pObj->IsA( TYPE( SbxObject ) ) )
4118 {
4119 SbxVariable* pVar = ((SbxObject*)pObj)->
4120 Find( String( RTL_CONSTASCII_USTRINGPARAM("Load") ), SbxCLASS_METHOD );
4121 if( pVar )
4122 pVar->GetInteger();
4123 }
4124 }
4125 }
4126
RTLFUNC(Unload)4127 RTLFUNC(Unload)
4128 {
4129 (void)pBasic;
4130 (void)bWrite;
4131
4132 rPar.Get(0)->PutEmpty();
4133 if( rPar.Count() != 2 )
4134 {
4135 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4136 return;
4137 }
4138
4139 // Diesen Call einfach an das Object weitereichen
4140 SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
4141 if ( pObj )
4142 {
4143 if( pObj->IsA( TYPE( SbUserFormModule ) ) )
4144 {
4145 SbUserFormModule* pFormModule = ( SbUserFormModule* )pObj;
4146 pFormModule->Unload();
4147 }
4148 else if( pObj->IsA( TYPE( SbxObject ) ) )
4149 {
4150 SbxVariable* pVar = ((SbxObject*)pObj)->
4151 Find( String( RTL_CONSTASCII_USTRINGPARAM("Unload") ), SbxCLASS_METHOD );
4152 if( pVar )
4153 pVar->GetInteger();
4154 }
4155 }
4156 }
4157
RTLFUNC(LoadPicture)4158 RTLFUNC(LoadPicture)
4159 {
4160 (void)pBasic;
4161 (void)bWrite;
4162
4163 if( rPar.Count() != 2 )
4164 {
4165 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4166 return;
4167 }
4168
4169 String aFileURL = getFullPath( rPar.Get(1)->GetString() );
4170 SvStream* pStream = utl::UcbStreamHelper::CreateStream( aFileURL, STREAM_READ );
4171 if( pStream != NULL )
4172 {
4173 Bitmap aBmp;
4174 ReadDIB(aBmp, *pStream, true);
4175 Graphic aGraphic(aBmp);
4176
4177 SbxObjectRef xRef = new SbStdPicture;
4178 ((SbStdPicture*)(SbxObject*)xRef)->SetGraphic( aGraphic );
4179 rPar.Get(0)->PutObject( xRef );
4180 }
4181 delete pStream;
4182 }
4183
RTLFUNC(SavePicture)4184 RTLFUNC(SavePicture)
4185 {
4186 (void)pBasic;
4187 (void)bWrite;
4188
4189 rPar.Get(0)->PutEmpty();
4190 if( rPar.Count() != 3 )
4191 {
4192 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4193 return;
4194 }
4195
4196 SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject();
4197 if( pObj->IsA( TYPE( SbStdPicture ) ) )
4198 {
4199 SvFileStream aOStream( rPar.Get(2)->GetString(), STREAM_WRITE | STREAM_TRUNC );
4200 Graphic aGraphic = ((SbStdPicture*)pObj)->GetGraphic();
4201 aOStream << aGraphic;
4202 }
4203 }
4204
4205
4206 //-----------------------------------------------------------------------------------------
4207
RTLFUNC(AboutStarBasic)4208 RTLFUNC(AboutStarBasic)
4209 {
4210 (void)pBasic;
4211 (void)bWrite;
4212 (void)rPar;
4213 }
4214
RTLFUNC(MsgBox)4215 RTLFUNC(MsgBox)
4216 {
4217 (void)pBasic;
4218 (void)bWrite;
4219
4220 static const WinBits nStyleMap[] =
4221 {
4222 WB_OK, // MB_OK
4223 WB_OK_CANCEL, // MB_OKCANCEL
4224 WB_ABORT_RETRY_IGNORE, // MB_ABORTRETRYIGNORE
4225 WB_YES_NO_CANCEL, // MB_YESNOCANCEL
4226 WB_YES_NO, // MB_YESNO
4227 WB_RETRY_CANCEL // MB_RETRYCANCEL
4228 };
4229 static const sal_Int16 nButtonMap[] =
4230 {
4231 2, // #define RET_CANCEL sal_False
4232 1, // #define RET_OK sal_True
4233 6, // #define RET_YES 2
4234 7, // #define RET_NO 3
4235 4 // #define RET_RETRY 4
4236 };
4237
4238
4239 sal_uInt16 nArgCount = (sal_uInt16)rPar.Count();
4240 if( nArgCount < 2 || nArgCount > 6 )
4241 {
4242 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4243 return;
4244 }
4245 WinBits nWinBits;
4246 WinBits nType = 0; // MB_OK
4247 if( nArgCount >= 3 )
4248 nType = (WinBits)rPar.Get(2)->GetInteger();
4249 WinBits nStyle = nType;
4250 nStyle &= 15; // Bits 4-16 loeschen
4251 if( nStyle > 5 )
4252 nStyle = 0;
4253
4254 nWinBits = nStyleMap[ nStyle ];
4255
4256 WinBits nWinDefBits;
4257 nWinDefBits = (WB_DEF_OK | WB_DEF_RETRY | WB_DEF_YES);
4258 if( nType & 256 )
4259 {
4260 if( nStyle == 5 )
4261 nWinDefBits = WB_DEF_CANCEL;
4262 else if( nStyle == 2 )
4263 nWinDefBits = WB_DEF_RETRY;
4264 else
4265 nWinDefBits = (WB_DEF_CANCEL | WB_DEF_RETRY | WB_DEF_NO);
4266 }
4267 else if( nType & 512 )
4268 {
4269 if( nStyle == 2)
4270 nWinDefBits = WB_DEF_IGNORE;
4271 else
4272 nWinDefBits = WB_DEF_CANCEL;
4273 }
4274 else if( nStyle == 2)
4275 nWinDefBits = WB_DEF_CANCEL;
4276 nWinBits |= nWinDefBits;
4277
4278 String aMsg = rPar.Get(1)->GetString();
4279 String aTitle;
4280 if( nArgCount >= 4 )
4281 aTitle = rPar.Get(3)->GetString();
4282 else
4283 aTitle = GetpApp()->GetAppName();
4284
4285 nType &= (16+32+64);
4286 MessBox* pBox = 0;
4287 Window* pParent = GetpApp()->GetDefDialogParent();
4288 switch( nType )
4289 {
4290 case 16:
4291 pBox = new ErrorBox( pParent, nWinBits, aMsg );
4292 break;
4293 case 32:
4294 pBox = new QueryBox( pParent, nWinBits, aMsg );
4295 break;
4296 case 48:
4297 pBox = new WarningBox( pParent, nWinBits, aMsg );
4298 break;
4299 case 64:
4300 pBox = new InfoBox( pParent, nWinBits, aMsg );
4301 break;
4302 default:
4303 pBox = new MessBox( pParent, nWinBits, aTitle, aMsg );
4304 }
4305 pBox->SetText( aTitle );
4306 sal_uInt16 nRet = (sal_uInt16)pBox->Execute();
4307 if( nRet == sal_True )
4308 nRet = 1;
4309
4310 sal_Int16 nMappedRet;
4311 if( nStyle == 2 )
4312 {
4313 nMappedRet = nRet;
4314 if( nMappedRet == 0 )
4315 nMappedRet = 3; // Abort
4316 }
4317 else
4318 nMappedRet = nButtonMap[ nRet ];
4319
4320 rPar.Get(0)->PutInteger( nMappedRet );
4321 delete pBox;
4322 }
4323
RTLFUNC(SetAttr)4324 RTLFUNC(SetAttr) // JSM
4325 {
4326 (void)pBasic;
4327 (void)bWrite;
4328
4329 rPar.Get(0)->PutEmpty();
4330 if ( rPar.Count() == 3 )
4331 {
4332 String aStr = rPar.Get(1)->GetString();
4333 sal_Int16 nFlags = rPar.Get(2)->GetInteger();
4334
4335 // <-- UCB
4336 if( hasUno() )
4337 {
4338 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
4339 if( xSFI.is() )
4340 {
4341 try
4342 {
4343 sal_Bool bReadOnly = (nFlags & 0x0001) != 0; // ATTR_READONLY
4344 xSFI->setReadOnly( aStr, bReadOnly );
4345 sal_Bool bHidden = (nFlags & 0x0002) != 0; // ATTR_HIDDEN
4346 xSFI->setHidden( aStr, bHidden );
4347 }
4348 catch( Exception & )
4349 {
4350 StarBASIC::Error( ERRCODE_IO_GENERAL );
4351 }
4352 }
4353 }
4354 else
4355 // --> UCB
4356 {
4357 #ifdef _OLD_FILE_IMPL
4358 // #57064 Bei virtuellen URLs den Real-Path extrahieren
4359 DirEntry aEntry( aStr );
4360 String aFile = aEntry.GetFull();
4361 ByteString aByteFile( aFile, gsl_getSystemTextEncoding() );
4362 #ifdef WNT
4363 if (!SetFileAttributes (aByteFile.GetBuffer(),(DWORD)nFlags))
4364 StarBASIC::Error(SbERR_FILE_NOT_FOUND);
4365 #endif
4366 #ifdef OS2
4367 FILESTATUS3 aFileStatus;
4368 APIRET rc = DosQueryPathInfo(aByteFile.GetBuffer(),1,
4369 &aFileStatus,sizeof(FILESTATUS3));
4370 if (!rc)
4371 {
4372 if (aFileStatus.attrFile != nFlags)
4373 {
4374 aFileStatus.attrFile = nFlags;
4375 rc = DosSetPathInfo(aFile.GetStr(),1,
4376 &aFileStatus,sizeof(FILESTATUS3),0);
4377 if (rc)
4378 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
4379 }
4380 }
4381 else
4382 StarBASIC::Error( SbERR_FILE_NOT_FOUND );
4383 #endif
4384 #else
4385 // Not implemented
4386 #endif
4387 }
4388 }
4389 else
4390 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4391 }
4392
RTLFUNC(Reset)4393 RTLFUNC(Reset) // JSM
4394 {
4395 (void)pBasic;
4396 (void)bWrite;
4397 (void)rPar;
4398
4399 SbiIoSystem* pIO = pINST->GetIoSystem();
4400 if (pIO)
4401 pIO->CloseAll();
4402 }
4403
RTLFUNC(DumpAllObjects)4404 RTLFUNC(DumpAllObjects)
4405 {
4406 (void)pBasic;
4407 (void)bWrite;
4408
4409 sal_uInt16 nArgCount = (sal_uInt16)rPar.Count();
4410 if( nArgCount < 2 || nArgCount > 3 )
4411 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4412 else if( !pBasic )
4413 StarBASIC::Error( SbERR_INTERNAL_ERROR );
4414 else
4415 {
4416 SbxObject* p = pBasic;
4417 while( p->GetParent() )
4418 p = p->GetParent();
4419 SvFileStream aStrm( rPar.Get( 1 )->GetString(),
4420 STREAM_WRITE | STREAM_TRUNC );
4421 p->Dump( aStrm, rPar.Get( 2 )->GetBool() );
4422 aStrm.Close();
4423 if( aStrm.GetError() != SVSTREAM_OK )
4424 StarBASIC::Error( SbERR_IO_ERROR );
4425 }
4426 }
4427
4428
RTLFUNC(FileExists)4429 RTLFUNC(FileExists)
4430 {
4431 (void)pBasic;
4432 (void)bWrite;
4433
4434 if ( rPar.Count() == 2 )
4435 {
4436 String aStr = rPar.Get(1)->GetString();
4437 sal_Bool bExists = sal_False;
4438
4439 // <-- UCB
4440 if( hasUno() )
4441 {
4442 com::sun::star::uno::Reference< XSimpleFileAccess3 > xSFI = getFileAccess();
4443 if( xSFI.is() )
4444 {
4445 try
4446 {
4447 bExists = xSFI->exists( aStr );
4448 }
4449 catch( Exception & )
4450 {
4451 StarBASIC::Error( ERRCODE_IO_GENERAL );
4452 }
4453 }
4454 }
4455 else
4456 // --> UCB
4457 {
4458 #ifdef _OLD_FILE_IMPL
4459 DirEntry aEntry( aStr );
4460 bExists = aEntry.Exists();
4461 #else
4462 DirectoryItem aItem;
4463 FileBase::RC nRet = DirectoryItem::get( getFullPathUNC( aStr ), aItem );
4464 bExists = (nRet == FileBase::E_None);
4465 #endif
4466 }
4467 rPar.Get(0)->PutBool( bExists );
4468 }
4469 else
4470 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4471 }
4472
RTLFUNC(Partition)4473 RTLFUNC(Partition)
4474 {
4475 (void)pBasic;
4476 (void)bWrite;
4477
4478 if ( rPar.Count() != 5 )
4479 {
4480 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4481 return;
4482 }
4483
4484 sal_Int32 nNumber = rPar.Get(1)->GetLong();
4485 sal_Int32 nStart = rPar.Get(2)->GetLong();
4486 sal_Int32 nStop = rPar.Get(3)->GetLong();
4487 sal_Int32 nInterval = rPar.Get(4)->GetLong();
4488
4489 if( nStart < 0 || nStop <= nStart || nInterval < 1 )
4490 {
4491 StarBASIC::Error( SbERR_BAD_ARGUMENT );
4492 return;
4493 }
4494
4495 // the Partition function inserts leading spaces before lowervalue and uppervalue
4496 // so that they both have the same number of characters as the string
4497 // representation of the value (Stop + 1). This ensures that if you use the output
4498 // of the Partition function with several values of Number, the resulting text
4499 // will be handled properly during any subsequent sort operation.
4500
4501 // calculate the maximun number of characters before lowervalue and uppervalue
4502 ::rtl::OUString aBeforeStart = ::rtl::OUString::valueOf( nStart - 1 );
4503 ::rtl::OUString aAfterStop = ::rtl::OUString::valueOf( nStop + 1 );
4504 sal_Int32 nLen1 = aBeforeStart.getLength();
4505 sal_Int32 nLen2 = aAfterStop.getLength();
4506 sal_Int32 nLen = nLen1 >= nLen2 ? nLen1:nLen2;
4507
4508 ::rtl::OUStringBuffer aRetStr( nLen * 2 + 1);
4509 ::rtl::OUString aLowerValue;
4510 ::rtl::OUString aUpperValue;
4511 if( nNumber < nStart )
4512 {
4513 aUpperValue = aBeforeStart;
4514 }
4515 else if( nNumber > nStop )
4516 {
4517 aLowerValue = aAfterStop;
4518 }
4519 else
4520 {
4521 sal_Int32 nLowerValue = nNumber;
4522 sal_Int32 nUpperValue = nLowerValue;
4523 if( nInterval > 1 )
4524 {
4525 nLowerValue = ((( nNumber - nStart ) / nInterval ) * nInterval ) + nStart;
4526 nUpperValue = nLowerValue + nInterval - 1;
4527 }
4528
4529 aLowerValue = ::rtl::OUString::valueOf( nLowerValue );
4530 aUpperValue = ::rtl::OUString::valueOf( nUpperValue );
4531 }
4532
4533 nLen1 = aLowerValue.getLength();
4534 nLen2 = aUpperValue.getLength();
4535
4536 if( nLen > nLen1 )
4537 {
4538 // appending the leading spaces for the lowervalue
4539 for ( sal_Int32 i= (nLen - nLen1) ; i > 0; --i )
4540 aRetStr.appendAscii(" ");
4541 }
4542 aRetStr.append( aLowerValue ).appendAscii(":");
4543 if( nLen > nLen2 )
4544 {
4545 // appending the leading spaces for the uppervalue
4546 for ( sal_Int32 i= (nLen - nLen2) ; i > 0; --i )
4547 aRetStr.appendAscii(" ");
4548 }
4549 aRetStr.append( aUpperValue );
4550 rPar.Get(0)->PutString( String(aRetStr.makeStringAndClear()) );
4551 }
4552