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