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