diff options
Diffstat (limited to 'basic/source/runtime')
| -rw-r--r-- | basic/source/runtime/basrdll.cxx | 141 | ||||
| -rw-r--r-- | basic/source/runtime/ddectrl.cxx | 232 | ||||
| -rw-r--r-- | basic/source/runtime/ddectrl.hxx | 102 | ||||
| -rw-r--r-- | basic/source/runtime/dllmgr.cxx | 702 | ||||
| -rw-r--r-- | basic/source/runtime/dllmgr.hxx | 135 | ||||
| -rw-r--r-- | basic/source/runtime/inputbox.cxx | 247 | ||||
| -rw-r--r-- | basic/source/runtime/iosys.cxx | 1257 | ||||
| -rw-r--r-- | basic/source/runtime/makefile.mk | 116 | ||||
| -rw-r--r-- | basic/source/runtime/methods.cxx | 3228 | ||||
| -rw-r--r-- | basic/source/runtime/methods1.cxx | 1266 | ||||
| -rw-r--r-- | basic/source/runtime/os2.asm | 89 | ||||
| -rw-r--r-- | basic/source/runtime/props.cxx | 504 | ||||
| -rw-r--r-- | basic/source/runtime/rtlproto.hxx | 354 | ||||
| -rw-r--r-- | basic/source/runtime/runtime.cxx | 934 | ||||
| -rw-r--r-- | basic/source/runtime/stdobj.cxx | 729 | ||||
| -rw-r--r-- | basic/source/runtime/stdobj1.cxx | 547 | ||||
| -rw-r--r-- | basic/source/runtime/step0.cxx | 799 | ||||
| -rw-r--r-- | basic/source/runtime/step1.cxx | 423 | ||||
| -rw-r--r-- | basic/source/runtime/step2.cxx | 960 | ||||
| -rw-r--r-- | basic/source/runtime/win.asm | 72 | ||||
| -rw-r--r-- | basic/source/runtime/wnt.asm | 84 |
21 files changed, 12921 insertions, 0 deletions
diff --git a/basic/source/runtime/basrdll.cxx b/basic/source/runtime/basrdll.cxx new file mode 100644 index 000000000000..01c7ed0922c4 --- /dev/null +++ b/basic/source/runtime/basrdll.cxx @@ -0,0 +1,141 @@ +/************************************************************************* + * + * $RCSfile: basrdll.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _SHL_HXX //autogen +#include <tools/shl.hxx> +#endif +#ifndef _SV_SVAPP_HXX //autogen +#include <vcl/svapp.hxx> +#endif +#ifndef _SOLAR_HRC +#include <svtools/solar.hrc> +#endif +#ifndef _INTN_HXX //autogen +#include <tools/intn.hxx> +#endif +#ifndef _TOOLS_DEBUG_HXX //autogen +#include <tools/debug.hxx> +#endif +#ifndef _SV_MSGBOX_HXX //autogen +#include <vcl/msgbox.hxx> +#endif + +#include <sbstar.hxx> +#include <basrdll.hxx> +#include <basrid.hxx> +#include <sb.hrc> + +BasicResId::BasicResId( USHORT nId ): + ResId( nId, (*(BasicDLL**)GetAppData(SHL_BASIC))->GetResMgr() ) +{ +} + +BasicDLL::BasicDLL() +{ + *(BasicDLL**)GetAppData(SHL_BASIC) = this; + pResMgr = NULL; + bDebugMode = FALSE; + bBreakEnabled = TRUE; +} + +BasicDLL::~BasicDLL() +{ + delete pResMgr; +} + +void BasicDLL::EnableBreak( BOOL bEnable ) +{ + BasicDLL* pThis = *(BasicDLL**)GetAppData(SHL_BASIC); + DBG_ASSERT( pThis, "BasicDLL::EnableBreak: Noch keine Instanz!" ); + if ( pThis ) + pThis->bBreakEnabled = bEnable; +} + +void BasicDLL::SetDebugMode( BOOL bDebugMode ) +{ + BasicDLL* pThis = *(BasicDLL**)GetAppData(SHL_BASIC); + DBG_ASSERT( pThis, "BasicDLL::EnableBreak: Noch keine Instanz!" ); + if ( pThis ) + pThis->bDebugMode = bDebugMode; +} + + +void BasicDLL::BasicBreak() +{ + //bJustStopping: Wenn jemand wie wild x-mal STOP drueckt, aber das Basic + // nicht schnell genug anhaelt, kommt die Box ggf. oefters... + static BOOL bJustStopping = FALSE; + + BasicDLL* pThis = *(BasicDLL**)GetAppData(SHL_BASIC); + DBG_ASSERT( pThis, "BasicDLL::EnableBreak: Noch keine Instanz!" ); + if ( pThis ) + { + if ( StarBASIC::IsRunning() && !bJustStopping && ( pThis->bBreakEnabled || pThis->bDebugMode ) ) + { + bJustStopping = TRUE; + StarBASIC::Stop(); + String aMessageStr( BasicResId( IDS_SBERR_TERMINATED ) ); + InfoBox( 0, aMessageStr ).Execute(); + bJustStopping = FALSE; + } + } +} + diff --git a/basic/source/runtime/ddectrl.cxx b/basic/source/runtime/ddectrl.cxx new file mode 100644 index 000000000000..90dc5a53a00b --- /dev/null +++ b/basic/source/runtime/ddectrl.cxx @@ -0,0 +1,232 @@ +/************************************************************************* + * + * $RCSfile: ddectrl.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _ERRCODE_HXX //autogen +#include <tools/errcode.hxx> +#endif +#ifndef _SVDDE_HXX //autogen +#include <svtools/svdde.hxx> +#endif +#pragma hdrstop +#include "ddectrl.hxx" +#ifndef _SBERRORS_HXX +#include <sberrors.hxx> +#endif + +//#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +#define DDE_FREECHANNEL ((DdeConnection*)0xffffffff) + +#define DDE_FIRSTERR 0x4000 +#define DDE_LASTERR 0x4011 + +static const SbError nDdeErrMap[] = +{ + /* DMLERR_ADVACKTIMEOUT */ 0x4000, SbERR_DDE_TIMEOUT, + /* DMLERR_BUSY */ 0x4001, SbERR_DDE_BUSY, + /* DMLERR_DATAACKTIMEOUT */ 0x4002, SbERR_DDE_TIMEOUT, + /* DMLERR_DLL_NOT_INITIALIZED */ 0x4003, SbERR_DDE_ERROR, + /* DMLERR_DLL_USAGE */ 0x4004, SbERR_DDE_ERROR, + /* DMLERR_EXECACKTIMEOUT */ 0x4005, SbERR_DDE_TIMEOUT, + /* DMLERR_INVALIDPARAMETER */ 0x4006, SbERR_DDE_ERROR, + /* DMLERR_LOW_MEMORY */ 0x4007, SbERR_DDE_ERROR, + /* DMLERR_MEMORY_ERROR */ 0x4008, SbERR_DDE_ERROR, + /* DMLERR_NOTPROCESSED */ 0x4009, SbERR_DDE_NOTPROCESSED, + /* DMLERR_NO_CONV_ESTABLISHED */ 0x400a, SbERR_DDE_NO_CHANNEL, + /* DMLERR_POKEACKTIMEOUT */ 0x400b, SbERR_DDE_TIMEOUT, + /* DMLERR_POSTMSG_FAILED */ 0x400c, SbERR_DDE_QUEUE_OVERFLOW, + /* DMLERR_REENTRANCY */ 0x400d, SbERR_DDE_ERROR, + /* DMLERR_SERVER_DIED */ 0x400e, SbERR_DDE_PARTNER_QUIT, + /* DMLERR_SYS_ERROR */ 0x400f, SbERR_DDE_ERROR, + /* DMLERR_UNADVACKTIMEOUT */ 0x4010, SbERR_DDE_TIMEOUT, + /* DMLERR_UNFOUND_QUEUE_ID */ 0x4011, SbERR_DDE_NO_CHANNEL +}; + +SbError SbiDdeControl::GetLastErr( DdeConnection* pConv ) +{ + if( !pConv ) + return 0; + long nErr = pConv->GetError(); + if( !nErr ) + return 0; + if( nErr < DDE_FIRSTERR || nErr > DDE_LASTERR ) + return SbERR_DDE_ERROR; + return nDdeErrMap[ 2*(nErr - DDE_FIRSTERR) + 1 ]; +} + +IMPL_LINK_INLINE( SbiDdeControl,Data , DdeData*, pData, +{ + aData = String::CreateFromAscii( (char*)(const void*)*pData ); + return 1; +} +) + +SbiDdeControl::SbiDdeControl() +{ + pConvList = new DdeConnections; + DdeConnection* pPtr = DDE_FREECHANNEL; + pConvList->Insert( pPtr ); +} + +SbiDdeControl::~SbiDdeControl() +{ + TerminateAll(); + delete pConvList; +} + +INT16 SbiDdeControl::GetFreeChannel() +{ + INT16 nListSize = (INT16)pConvList->Count(); + DdeConnection* pPtr = pConvList->First(); + pPtr = pConvList->Next(); // nullten eintrag ueberspringen + INT16 nChannel; + for( nChannel = 1; nChannel < nListSize; nChannel++ ) + { + if( pPtr == DDE_FREECHANNEL ) + return nChannel; + pPtr = pConvList->Next(); + } + pPtr = DDE_FREECHANNEL; + pConvList->Insert( pPtr, LIST_APPEND ); + return nChannel; +} + +SbError SbiDdeControl::Initiate( const String& rService, const String& rTopic, + INT16& rnHandle ) +{ + SbError nErr; + DdeConnection* pConv = new DdeConnection( rService, rTopic ); + nErr = GetLastErr( pConv ); + if( nErr ) + { + delete pConv; + rnHandle = 0; + } + else + { + INT16 nChannel = GetFreeChannel(); + pConvList->Replace( pConv, (ULONG)nChannel ); + rnHandle = nChannel; + } + return 0; +} + +SbError SbiDdeControl::Terminate( INT16 nChannel ) +{ + DdeConnection* pConv = pConvList->GetObject( (ULONG)nChannel ); + if( !nChannel || !pConv || pConv == DDE_FREECHANNEL ) + return SbERR_DDE_NO_CHANNEL; + pConvList->Replace( DDE_FREECHANNEL, (ULONG)nChannel ); + delete pConv; + return 0L; +} + +SbError SbiDdeControl::TerminateAll() +{ + INT16 nChannel = (INT16)pConvList->Count(); + while( nChannel ) + { + nChannel--; + Terminate( nChannel ); + } + + pConvList->Clear(); + DdeConnection* pPtr = DDE_FREECHANNEL; + pConvList->Insert( pPtr ); + + return 0; +} + +SbError SbiDdeControl::Request( INT16 nChannel, const String& rItem, String& rResult ) +{ + DdeConnection* pConv = pConvList->GetObject( (ULONG)nChannel ); + if( !nChannel || !pConv || pConv == DDE_FREECHANNEL ) + return SbERR_DDE_NO_CHANNEL; + + DdeRequest aRequest( *pConv, rItem, 30000 ); + aRequest.SetDataHdl( LINK( this, SbiDdeControl, Data ) ); + aRequest.Execute(); + rResult = aData; + return GetLastErr( pConv ); +} + +SbError SbiDdeControl::Execute( INT16 nChannel, const String& rCommand ) +{ + DdeConnection* pConv = pConvList->GetObject( (ULONG)nChannel ); + if( !nChannel || !pConv || pConv == DDE_FREECHANNEL ) + return SbERR_DDE_NO_CHANNEL; + DdeExecute aRequest( *pConv, rCommand, 30000 ); + aRequest.Execute(); + return GetLastErr( pConv ); +} + +SbError SbiDdeControl::Poke( INT16 nChannel, const String& rItem, const String& rData ) +{ + DdeConnection* pConv = pConvList->GetObject( (ULONG)nChannel ); + if( !nChannel || !pConv || pConv == DDE_FREECHANNEL ) + return SbERR_DDE_NO_CHANNEL; + DdePoke aRequest( *pConv, rItem, DdeData(rData), 30000 ); + aRequest.Execute(); + return GetLastErr( pConv ); +} + + diff --git a/basic/source/runtime/ddectrl.hxx b/basic/source/runtime/ddectrl.hxx new file mode 100644 index 000000000000..a69faeeeb4e8 --- /dev/null +++ b/basic/source/runtime/ddectrl.hxx @@ -0,0 +1,102 @@ +/************************************************************************* + * + * $RCSfile: ddectrl.hxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _DDECTRL_HXX +#define _DDECTRL_HXX + +#ifndef _LINK_HXX //autogen +#include <tools/link.hxx> +#endif +#ifndef _SBERRORS_HXX +#include "sberrors.hxx" +#endif +#ifndef _STRING_HXX //autogen +#include <tools/string.hxx> +#endif + +class DdeConnection; +class DdeConnections; +class DdeData; + +class SbiDdeControl +{ +private: + DECL_LINK( Data, DdeData* ); + SbError GetLastErr( DdeConnection* ); + INT16 GetFreeChannel(); + DdeConnections* pConvList; + String aData; + +public: + + SbiDdeControl(); + ~SbiDdeControl(); + + SbError Initiate( const String& rService, const String& rTopic, + INT16& rnHandle ); + SbError Terminate( INT16 nChannel ); + SbError TerminateAll(); + SbError Request( INT16 nChannel, const String& rItem, String& rResult ); + SbError Execute( INT16 nChannel, const String& rCommand ); + SbError Poke( INT16 nChannel, const String& rItem, const String& rData ); +}; + +#endif diff --git a/basic/source/runtime/dllmgr.cxx b/basic/source/runtime/dllmgr.cxx new file mode 100644 index 000000000000..76a608674351 --- /dev/null +++ b/basic/source/runtime/dllmgr.cxx @@ -0,0 +1,702 @@ +/************************************************************************* + * + * $RCSfile: dllmgr.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#include <stdlib.h> +#ifdef OS2 +#define INCL_DOSMODULEMGR +#include <tools/svpm.h> +#endif + +#if defined( WIN ) || defined( WNT ) +#ifndef _SVWIN_H +#include <tools/svwin.h> +#endif +#endif +#ifndef _TOOLS_DEBUG_HXX //autogen +#include <tools/debug.hxx> +#endif +#ifndef _STRING_HXX //autogen +#include <tools/string.hxx> +#endif +#ifndef _ERRCODE_HXX //autogen +#include <tools/errcode.hxx> +#endif +#ifndef _SBXVAR_HXX //autogen +#include <svtools/sbxvar.hxx> +#endif +#ifndef _SBXCLASS_HXX //autogen +#include <svtools/sbx.hxx> +#endif + +#if defined(WIN) +typedef HINSTANCE SbiDllHandle; +typedef FARPROC SbiDllProc; +#elif defined(WNT) +typedef HMODULE SbiDllHandle; +typedef int(*SbiDllProc)(); +#elif defined(OS2) +typedef HMODULE SbiDllHandle; +typedef PFN SbiDllProc; + +#else +typedef void* SbiDllHandle; +typedef void* SbiDllProc; +#endif + +#define _DLLMGR_CXX +#include "dllmgr.hxx" +#include <sberrors.hxx> + +#ifndef CDECL +#ifdef WNT +//#define CDECL __cdecl +#define CDECL +#else +#ifdef WTC +#define CDECL cdecl +#else +#if defined(ICC) && defined(OS2) +#define CDECL _System +#else +#define CDECL +#endif +#endif +#endif +#endif + +extern "C" { +#if defined(INTEL) && (defined(WIN) || defined(WNT) || defined(OS2)) + +extern INT16 CDECL CallINT( SbiDllProc, char *stack, short nstack); +extern INT32 CDECL CallLNG( SbiDllProc, char *stack, short nstack); +#ifndef WNT +extern float CDECL CallSNG( SbiDllProc, char *stack, short nstack); +#endif +extern double CDECL CallDBL( SbiDllProc, char *stack, short nstack); +extern char* CDECL CallSTR( SbiDllProc, char *stack, short nstack); +// extern CallFIX( SbiDllProc, char *stack, short nstack); + +#else + +INT16 CallINT( SbiDllProc, char *, short ) { return 0; } +INT32 CallLNG( SbiDllProc, char *, short ) { return 0; } +float CallSNG( SbiDllProc, char *, short ) { return 0; } +double CallDBL( SbiDllProc, char *, short) { return 0; } +char* CallSTR( SbiDllProc, char *, short ) { return 0; } +#endif +} + +SV_IMPL_OP_PTRARR_SORT(ImplDllArr,ByteStringPtr) + +/* mit Optimierung An stuerzt unter Win95 folgendes Makro ab: +declare Sub MessageBeep Lib "user32" (ByVal long) +sub main + MessageBeep( 1 ) +end sub +*/ +#if defined (WNT) && defined (MSC) +//#pragma optimize ("", off) +#endif + +// +// *********************************************************************** +// + +class ImplSbiProc : public ByteString +{ + SbiDllProc pProc; + ImplSbiProc(); + ImplSbiProc( const ImplSbiProc& ); + +public: + ImplSbiProc( const ByteString& rName, SbiDllProc pFunc ) + : ByteString( rName ) { pProc = pFunc; } + SbiDllProc GetProc() const { return pProc; } +}; + +// +// *********************************************************************** +// + +class ImplSbiDll : public ByteString +{ + ImplDllArr aProcArr; + SbiDllHandle hDLL; + + ImplSbiDll( const ImplSbiDll& ); +public: + ImplSbiDll( const ByteString& rName, SbiDllHandle hHandle ) + : ByteString( rName ) { hDLL = hHandle; } + ~ImplSbiDll(); + SbiDllHandle GetHandle() const { return hDLL; } + SbiDllProc GetProc( const ByteString& rName ) const; + void InsertProc( const ByteString& rName, SbiDllProc pProc ); +}; + +ImplSbiDll::~ImplSbiDll() +{ + USHORT nCount = aProcArr.Count(); + for( USHORT nCur = 0; nCur < nCount; nCur++ ) + { + ImplSbiProc* pProc = (ImplSbiProc*)aProcArr.GetObject( nCur ); + delete pProc; + } +} + +SbiDllProc ImplSbiDll::GetProc( const ByteString& rName ) const +{ + USHORT nPos; + BOOL bRet = aProcArr.Seek_Entry( (ByteStringPtr)&rName, &nPos ); + if( bRet ) + { + ImplSbiProc* pImplProc = (ImplSbiProc*)aProcArr.GetObject(nPos); + return pImplProc->GetProc(); + } + return (SbiDllProc)0; +} + +void ImplSbiDll::InsertProc( const ByteString& rName, SbiDllProc pProc ) +{ + DBG_ASSERT(aProcArr.Seek_Entry((ByteStringPtr)&rName,0)==0,"InsertProc: Already in table"); + ImplSbiProc* pImplProc = new ImplSbiProc( rName, pProc ); + aProcArr.Insert( (ByteStringPtr)pImplProc ); +} + + +// +// *********************************************************************** +// + +SbiDllMgr::SbiDllMgr( const SbiDllMgr& ) +{ +} + +SbiDllMgr::SbiDllMgr() +{ +} + +SbiDllMgr::~SbiDllMgr() +{ + USHORT nCount = aDllArr.Count(); + for( USHORT nCur = 0; nCur < nCount; nCur++ ) + { + ImplSbiDll* pDll = (ImplSbiDll*)aDllArr.GetObject( nCur ); + FreeDllHandle( pDll->GetHandle() ); + delete pDll; + } +} + +void SbiDllMgr::FreeDll( const ByteString& rDllName ) +{ + USHORT nPos; + BOOL bRet = aDllArr.Seek_Entry( (ByteStringPtr)&rDllName, &nPos ); + if( bRet ) + { + ImplSbiDll* pDll = (ImplSbiDll*)aDllArr.GetObject(nPos); + FreeDllHandle( pDll->GetHandle() ); + delete pDll; + aDllArr.Remove( nPos, 1 ); + } +} + + +ImplSbiDll* SbiDllMgr::GetDll( const ByteString& rDllName ) +{ + USHORT nPos; + ImplSbiDll* pDll = 0; + BOOL bRet = aDllArr.Seek_Entry( (ByteStringPtr)&rDllName, &nPos ); + if( bRet ) + pDll = (ImplSbiDll*)aDllArr.GetObject(nPos); + else + { + SbiDllHandle hDll = CreateDllHandle( rDllName ); + if( hDll ) + { + pDll = new ImplSbiDll( rDllName, hDll ); + aDllArr.Insert( (ByteStringPtr)pDll ); + } + } + return pDll; +} + +SbiDllProc SbiDllMgr::GetProc( ImplSbiDll* pDll, const ByteString& rProcName ) +{ + DBG_ASSERT(pDll,"GetProc: No dll-ptr"); + SbiDllProc pProc; + pProc = pDll->GetProc( rProcName ); + if( !pProc ) + { + pProc = GetProcAddr( pDll->GetHandle(), rProcName ); + if( pProc ) + pDll->InsertProc( rProcName, pProc ); + } + return pProc; +} + + +SbError SbiDllMgr::Call( const char* pProcName, const char* pDllName, + SbxArray* pArgs, SbxVariable& rResult, BOOL bCDecl ) +{ + DBG_ASSERT(pProcName&&pDllName,"Call: Bad parms"); + SbError nSbErr = 0; + ByteString aDllName( pDllName ); + CheckDllName( aDllName ); + ImplSbiDll* pDll = GetDll( aDllName ); + if( pDll ) + { + SbiDllProc pProc = GetProc( pDll, pProcName ); + if( pProc ) + { + if( bCDecl ) + nSbErr = CallProcC( pProc, pArgs, rResult ); + else + nSbErr = CallProc( pProc, pArgs, rResult ); + } + else + nSbErr = SbERR_PROC_UNDEFINED; + } + else + nSbErr = SbERR_BAD_DLL_LOAD; + return nSbErr; +} + +// *********************************************************************** +// ******************* abhaengige Implementationen *********************** +// *********************************************************************** + +void SbiDllMgr::CheckDllName( ByteString& rDllName ) +{ +#if defined(WIN) || defined(WNT) // || defined(OS2) + if( rDllName.Search('.') == STRING_NOTFOUND ) + rDllName += ".DLL"; +#endif +} + + +SbiDllHandle SbiDllMgr::CreateDllHandle( const ByteString& rDllName ) +{ +#if defined(MAC) || defined(UNX) + SbiDllHandle hLib=0; +#else + SbiDllHandle hLib; +#endif + +#if defined(WIN) + hLib = LoadLibrary( (const char*)rDllName ); + if( (ULONG)hLib < 32 ) + hLib = 0; + +#elif defined(WNT) + hLib = LoadLibrary( rDllName.GetBuffer() ); + if( !(ULONG)hLib ) + { +#ifdef DBG_UTIL + ULONG nLastErr = GetLastError(); +#endif + hLib = 0; + } + +#elif defined(OS2) + char cErr[ 100 ]; + if( DosLoadModule( (PSZ) cErr, 100, (const char*)rDllName, &hLib ) ) + hLib = 0; +#endif + return hLib; +} + +void SbiDllMgr::FreeDllHandle( SbiDllHandle hLib ) +{ +#if defined(WIN) || defined(WNT) + if( hLib ) + FreeLibrary ((HINSTANCE) hLib); +#elif defined(OS2) + if( hLib ) + DosFreeModule( (HMODULE) hLib ); +#endif +} + +SbiDllProc SbiDllMgr::GetProcAddr(SbiDllHandle hLib, const ByteString& rProcName) +{ + char buf1 [128]; + char buf2 [128]; + + SbiDllProc pProc = 0; + short nOrd = 0; + + // Ordinal? + if( rProcName.GetBuffer()[0] == '@' ) + nOrd = atoi( rProcName.GetBuffer()+1 ); + + // Moegliche Parameter weg: + strcpy( buf1, rProcName.GetBuffer() ); + char *p = strchr( buf1, '#' ); + if( p ) + *p = 0; + strcpy( buf2, "_" ); + strcat( buf2, buf1 ); + +#if defined(WIN) || defined(WNT) + if( nOrd > 0 ) + pProc = (SbiDllProc)GetProcAddress( hLib, (char*)(long) nOrd ); + else + { + // 2. mit Parametern: + pProc = (SbiDllProc)GetProcAddress ( hLib, rProcName.GetBuffer() ); + // 3. nur der Name: + if (!pProc) + pProc = (SbiDllProc)GetProcAddress( hLib, buf1 ); + // 4. der Name mit Underline vorweg: + if( !pProc ) + pProc = (SbiDllProc)GetProcAddress( hLib, buf2 ); + } + +#elif defined(OS2) + PSZ pp; + APIRET rc; + // 1. Ordinal oder mit Parametern: + rc = DosQueryProcAddr( hLib, nOrd, pp = (char*)rProcName.GetStr(), &pProc ); + // 2. nur der Name: + if( rc ) + rc = DosQueryProcAddr( hLib, 0, pp = (PSZ)buf1, &pProc ); + // 3. der Name mit Underline vorweg: + if( rc ) + rc = DosQueryProcAddr( hLib, 0, pp = (PSZ)buf2, &pProc ); + if( rc ) + pProc = NULL; + else + { + // 16-bit oder 32-bit? + ULONG nInfo = 0; + if( DosQueryProcType( hLib, nOrd, pp, &nInfo ) ) + nInfo = 0;; + } +#endif + return pProc; +} + +SbError SbiDllMgr::CallProc( SbiDllProc pProc, SbxArray* pArgs, + SbxVariable& rResult ) +{ +// ByteString aStr("Calling DLL at "); +// aStr += (ULONG)pProc; +// InfoBox( 0, aStr ).Execute(); + INT16 nInt16; int nInt; INT32 nInt32; float nSingle; double nDouble; + char* pStr; + + USHORT nSize; + char* pStack = (char*)CreateStack( pArgs, nSize ); + switch( rResult.GetType() ) + { + case SbxINTEGER: + nInt16 = CallINT(pProc, pStack, (short)nSize ); + rResult.PutInteger( nInt16 ); + break; + + case SbxUINT: + case SbxUSHORT: + nInt16 = (INT16)CallINT(pProc, pStack, (short)nSize ); + rResult.PutUShort( (USHORT)nInt16 ); + break; + + case SbxERROR: + nInt16 = (INT16)CallINT(pProc, pStack, (short)nSize ); + rResult.PutErr( (USHORT)nInt16 ); + break; + + case SbxINT: + nInt = CallINT(pProc, pStack, (short)nSize ); + rResult.PutInt( nInt ); + break; + + case SbxLONG: + nInt32 = CallLNG(pProc, pStack, (short)nSize ); + rResult.PutLong( nInt32 ); + break; + + case SbxULONG: + nInt32 = CallINT(pProc, pStack, (short)nSize ); + rResult.PutULong( (ULONG)nInt32 ); + break; + +#ifndef WNT + case SbxSINGLE: + nSingle = CallSNG(pProc, pStack, (short)nSize ); + rResult.PutSingle( nSingle ); + break; +#endif + + case SbxDOUBLE: +#ifdef WNT + case SbxSINGLE: +#endif + nDouble = CallDBL(pProc, pStack, (short)nSize ); + rResult.PutDouble( nDouble ); + break; + + case SbxDATE: + nDouble = CallDBL(pProc, pStack, (short)nSize ); + rResult.PutDate( nDouble ); + break; + + case SbxCHAR: + case SbxBYTE: + case SbxBOOL: + nInt16 = CallINT(pProc, pStack, (short)nSize ); + rResult.PutByte( (BYTE)nInt16 ); + break; + + case SbxSTRING: + case SbxLPSTR: + pStr = CallSTR(pProc, pStack, (short)nSize ); + rResult.PutString( String::CreateFromAscii( pStr ) ); + break; + + case SbxNULL: + case SbxEMPTY: + nInt16 = CallINT(pProc, pStack, (short)nSize ); + // Rueckgabe nur zulaessig, wenn variant! + if( !rResult.IsFixed() ) + rResult.PutInteger( nInt16 ); + break; + + case SbxCURRENCY: + case SbxOBJECT: + case SbxDATAOBJECT: + default: + CallINT(pProc, pStack, (short)nSize ); + break; + } + delete pStack; + + if( pArgs ) + { + // die Laengen aller uebergebenen Strings anpassen + USHORT nCount = pArgs->Count(); + for( USHORT nCur = 1; nCur < nCount; nCur++ ) + { + SbxVariable* pVar = pArgs->Get( nCur ); + BOOL bIsString = ( pVar->GetType() == SbxSTRING ) || + ( pVar->GetType() == SbxLPSTR ); + + if( pVar->GetFlags() & SBX_REFERENCE ) + { + pVar->ResetFlag( SBX_REFERENCE ); // Sbx moechte es so + if( bIsString ) + { + ByteString aByteStr( (char*)pVar->GetUserData() ); + String aStr( aByteStr, gsl_getSystemTextEncoding() ); + pVar->PutString( aStr ); + } + } + if( bIsString ) + { + delete (char*)(pVar->GetUserData()); + pVar->SetUserData( 0 ); + } + } + } + return 0; +} + +SbError SbiDllMgr::CallProcC( SbiDllProc pProc, SbxArray* pArgs, + SbxVariable& rResult ) +{ + DBG_ERROR("C calling convention not supported"); + return (USHORT)SbERR_BAD_ARGUMENT; +} + +void* SbiDllMgr::CreateStack( SbxArray* pArgs, USHORT& rSize ) +{ + if( !pArgs ) + { + rSize = 0; + return 0; + } + char* pStack = new char[ 2048 ]; + char* pTop = pStack; + USHORT nCount = pArgs->Count(); + // erstes Element ueberspringen +#ifndef WIN + for( USHORT nCur = 1; nCur < nCount; nCur++ ) +#else + // unter 16-Bit Windows anders rum (OS/2 ?????) + for( USHORT nCur = nCount-1; nCur >= 1; nCur-- ) +#endif + { + SbxVariable* pVar = pArgs->Get( nCur ); + // AB 22.1.1996, Referenz + if( pVar->GetFlags() & SBX_REFERENCE ) // Es ist eine Referenz + { + switch( pVar->GetType() ) + { + case SbxINTEGER: + case SbxUINT: + case SbxINT: + case SbxUSHORT: + case SbxLONG: + case SbxULONG: + case SbxSINGLE: + case SbxDOUBLE: + case SbxCHAR: + case SbxBYTE: + case SbxBOOL: + *((void**)pTop) = (void*)&(pVar->aData); + pTop += sizeof( void* ); + break; + + case SbxSTRING: + case SbxLPSTR: + { + USHORT nLen = 256; + ByteString rStr( pVar->GetString(), gsl_getSystemTextEncoding() ); + if( rStr.Len() > 255 ) + nLen = rStr.Len() + 1; + + char* pStr = new char[ nLen ]; + strcpy( pStr, rStr.GetBuffer() ); + // ist nicht so sauber, aber wir sparen ein Pointerarray + DBG_ASSERT(sizeof(UINT32)>=sizeof(char*),"Gleich krachts im Basic"); + pVar->SetUserData( (UINT32)pStr ); + *((const char**)pTop) = pStr; + pTop += sizeof( char* ); + } + break; + + case SbxNULL: + case SbxEMPTY: + case SbxERROR: + case SbxDATE: + case SbxCURRENCY: + case SbxOBJECT: + case SbxDATAOBJECT: + default: + break; + } + } + else + { + // ByVal + switch( pVar->GetType() ) + { + case SbxINTEGER: + case SbxUINT: + case SbxINT: + case SbxUSHORT: + *((INT16*)pTop) = pVar->GetInteger(); + pTop += sizeof( INT16 ); + break; + + case SbxLONG: + case SbxULONG: + *((INT32*)pTop) = pVar->GetLong(); + pTop += sizeof( INT32 ); + break; + + case SbxSINGLE: + *((float*)pTop) = pVar->GetSingle(); + pTop += sizeof( float ); + break; + + case SbxDOUBLE: + *((double*)pTop) = pVar->GetDouble(); + pTop += sizeof( double ); + break; + + case SbxSTRING: + case SbxLPSTR: + { + char* pStr = new char[ pVar->GetString().Len() + 1 ]; + ByteString aByteStr( pVar->GetString(), gsl_getSystemTextEncoding() ); + strcpy( pStr, aByteStr.GetBuffer() ); + // ist nicht so sauber, aber wir sparen ein Pointerarray + DBG_ASSERT(sizeof(UINT32)>=sizeof(char*),"Gleich krachts im Basic"); + pVar->SetUserData( (UINT32)pStr ); + *((const char**)pTop) = pStr; + pTop += sizeof( char* ); + } + break; + + case SbxCHAR: + case SbxBYTE: + case SbxBOOL: + *((BYTE*)pTop) = pVar->GetByte(); + pTop += sizeof( BYTE ); + break; + + case SbxNULL: + case SbxEMPTY: + case SbxERROR: + case SbxDATE: + case SbxCURRENCY: + case SbxOBJECT: + case SbxDATAOBJECT: + default: + break; + } + } + } + rSize = (USHORT)((ULONG)pTop - (ULONG)pStack); + return pStack; +} + + + + diff --git a/basic/source/runtime/dllmgr.hxx b/basic/source/runtime/dllmgr.hxx new file mode 100644 index 000000000000..dafe6942c518 --- /dev/null +++ b/basic/source/runtime/dllmgr.hxx @@ -0,0 +1,135 @@ +/************************************************************************* + * + * $RCSfile: dllmgr.hxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _DLLMGR_HXX +#define _DLLMGR_HXX + +#define _SVSTDARR_BYTESTRINGSSORT +#ifndef _SVARRAY_HXX //autogen +#include <svtools/svarray.hxx> +#endif +#ifndef _SVSTDARR_HXX //autogen +#include <svtools/svstdarr.hxx> +#endif + +// !!! nur zum debuggen fuer infoboxes !!! +//#ifndef _SV_HXX +//#include <sv.hxx> +//#endif + +//#ifndef _TOOLS_HXX +//#include <tools.hxx> +//#endif +#if SUPD > 340 +#define _SVSTDARR_STRINGS +//#ifndef _SVSTDARR_HXX +//#include <svstdarr.hxx> +//#endif +#else +//#include <svmem.hxx> +#endif +#ifndef _SBERRORS_HXX +#include <sberrors.hxx> +#endif + +class SbxArray; +class SbxVariable; + +class ImplSbiDll; +class ImplSbiProc; + +SV_DECL_PTRARR_SORT(ImplDllArr,ByteStringPtr,5,5) + +class SbiDllMgr +{ + ImplDllArr aDllArr; + + SbiDllMgr( const SbiDllMgr& ); + +#ifdef _DLLMGR_CXX + ImplSbiDll* GetDll( const ByteString& rDllName ); + SbiDllProc GetProc( ImplSbiDll*, const ByteString& rProcName ); + + SbiDllHandle CreateDllHandle( const ByteString& rDllName ); + void FreeDllHandle( SbiDllHandle ); + SbiDllProc GetProcAddr( SbiDllHandle, const ByteString& pProcName ); + SbError CallProc( SbiDllProc pProc, SbxArray* pArgs, + SbxVariable& rResult ); + SbError CallProcC( SbiDllProc pProc, SbxArray* pArgs, + SbxVariable& rResult ); + void* CreateStack( SbxArray* pArgs, USHORT& rSize ); + void CheckDllName( ByteString& rName ); +#endif + +public: + SbiDllMgr(); + ~SbiDllMgr(); + + SbError Call( const char* pFunc, const char* pDll, + SbxArray* pArgs, SbxVariable& rResult, + BOOL bCDecl ); + + void FreeDll( const ByteString& rDllName ); +}; + + + +#endif diff --git a/basic/source/runtime/inputbox.cxx b/basic/source/runtime/inputbox.cxx new file mode 100644 index 000000000000..236bf9e1e8a7 --- /dev/null +++ b/basic/source/runtime/inputbox.cxx @@ -0,0 +1,247 @@ +/************************************************************************* + * + * $RCSfile: inputbox.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef NOOLDSV //autogen +#include <vcl/system.hxx> +#endif +#ifndef _SV_BUTTON_HXX //autogen +#include <vcl/button.hxx> +#endif +#ifndef _SV_FIXED_HXX //autogen +#include <vcl/fixed.hxx> +#endif +#ifndef _SV_EDIT_HXX //autogen +#include <vcl/edit.hxx> +#endif +#ifndef _SV_DIALOG_HXX //autogen +#include <vcl/dialog.hxx> +#endif +#ifndef _SV_SVAPP_HXX +#include <vcl/svapp.hxx> +#endif +#include <svtools/sbx.hxx> +#include "runtime.hxx" +#pragma hdrstop +#include "stdobj.hxx" +#include "rtlproto.hxx" + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + + +class SvRTLInputBox : public ModalDialog +{ + Edit aEdit; + OKButton aOk; + CancelButton aCancel; + FixedText aPromptText; + String aText; + + void PositionDialog( long nXTwips, long nYTwips, const Size& rDlgSize ); + void InitButtons( const Size& rDlgSize ); + void PositionEdit( const Size& rDlgSize ); + void PositionPrompt( const String& rPrompt, const Size& rDlgSize ); + DECL_LINK( OkHdl, Button * ); + DECL_LINK( CancelHdl, Button * ); + +public: + SvRTLInputBox( Window* pParent, const String& rPrompt, const String& rTitle, + const String& rDefault, long nXTwips = -1, long nYTwips = -1 ); + String GetText() const { return aText; } +}; + +SvRTLInputBox::SvRTLInputBox( Window* pParent, const String& rPrompt, + const String& rTitle, const String& rDefault, + long nXTwips, long nYTwips ) : + ModalDialog( pParent,WB_SVLOOK | WB_MOVEABLE | WB_CLOSEABLE ), + aEdit( this, WB_LEFT | WB_BORDER ), + aOk( this ), aCancel( this ), aPromptText( this, WB_WORDBREAK ) +{ + SetMapMode( MapMode( MAP_APPFONT ) ); + Size aDlgSizeApp( 280, 80 ); + PositionDialog( nXTwips, nYTwips, aDlgSizeApp ); + InitButtons( aDlgSizeApp ); + PositionEdit( aDlgSizeApp ); + PositionPrompt( rPrompt, aDlgSizeApp ); + aOk.Show(); + aCancel.Show(); + aEdit.Show(); + aPromptText.Show(); + SetText( rTitle ); + Font aFont( GetFont()); + Color aColor( GetBackgroundBrush().GetFillColor()); + aFont.SetFillColor( aColor ); + aEdit.SetFont( aFont ); + aEdit.SetText( rDefault ); + aEdit.SetSelection( Selection( SELECTION_MIN, SELECTION_MAX ) ); +} + +void SvRTLInputBox::InitButtons( const Size& rDlgSize ) +{ + aOk.SetSizePixel( LogicToPixel( Size( 45, 15) )); + aCancel.SetSizePixel( LogicToPixel( Size( 45, 15) )); + Point aPos( rDlgSize.Width()-45-10, 5 ); + aOk.SetPosPixel( LogicToPixel( Point(aPos) )); + aPos.Y() += 16; + aCancel.SetPosPixel( LogicToPixel( Point(aPos) )); + aOk.SetClickHdl(LINK(this,SvRTLInputBox, OkHdl)); + aCancel.SetClickHdl(LINK(this,SvRTLInputBox,CancelHdl)); +} + +void SvRTLInputBox::PositionDialog(long nXTwips, long nYTwips, const Size& rDlgSize) +{ + Size aScreenSzApp(Window::GetOutputSizePixel()); + aScreenSzApp = PixelToLogic( aScreenSzApp ); + + Point aDlgPosApp( nXTwips, nYTwips ); + aDlgPosApp = LogicToPixel( aDlgPosApp, MAP_TWIP ); + aDlgPosApp = PixelToLogic( aDlgPosApp ); + if ( nXTwips == -1 || nYTwips == -1 || + aDlgPosApp.X() >= aScreenSzApp.Width() || + aDlgPosApp.Y() >= aScreenSzApp.Height() ) + { + aDlgPosApp.X() = ( aScreenSzApp.Width() - rDlgSize.Width() ) / 2; + aDlgPosApp.Y() = ( aScreenSzApp.Height() - rDlgSize.Height() ) / 2; + } + SetSizePixel( LogicToPixel(rDlgSize) ); + SetPosPixel( LogicToPixel(aDlgPosApp) ); +} + +void SvRTLInputBox::PositionEdit( const Size& rDlgSize ) +{ + aEdit.SetPosPixel( LogicToPixel( Point( 5,rDlgSize.Height()-35))); + aEdit.SetSizePixel( LogicToPixel( Size(rDlgSize.Width()-15,12))); +} + + +void SvRTLInputBox::PositionPrompt(const String& rPrompt,const Size& rDlgSize) +{ + if ( rPrompt.Len() == 0 ) + return; + String aText( rPrompt ); + aText.ConvertLineEnd( LINEEND_CR ); + aPromptText.SetPosPixel( LogicToPixel(Point(5,5))); + aPromptText.SetText( aText ); + Size aSize( rDlgSize ); + aSize.Width() -= 70; + aSize.Height() -= 50; + aPromptText.SetSizePixel( LogicToPixel(aSize)); +} + + +IMPL_LINK_INLINE_START( SvRTLInputBox, OkHdl, Button *, pButton ) +{ + aText = aEdit.GetText(); + EndDialog( 1 ); + return 0; +} +IMPL_LINK_INLINE_END( SvRTLInputBox, OkHdl, Button *, pButton ) + +IMPL_LINK_INLINE_START( SvRTLInputBox, CancelHdl, Button *, pButton ) +{ + aText.Erase(); + EndDialog( 0 ); + return 0; +} +IMPL_LINK_INLINE_END( SvRTLInputBox, CancelHdl, Button *, pButton ) + + +// ********************************************************************* +// ********************************************************************* +// ********************************************************************* + +// Syntax: String InputBox( Prompt, [Title], [Default] [, nXpos, nYpos ] ) + +RTLFUNC(InputBox) +{ + ULONG nArgCount = rPar.Count(); + if ( nArgCount < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aTitle; + String aDefault; + INT32 nX = -1, nY = -1; // zentrieren + const String& rPrompt = rPar.Get(1)->GetString(); + if ( nArgCount > 2 ) + aTitle = rPar.Get(2)->GetString(); + if ( nArgCount > 3 ) + aDefault = rPar.Get(3)->GetString(); + if ( nArgCount > 4 ) + { + if ( nArgCount != 6 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + nX = rPar.Get(4)->GetLong(); + nY = rPar.Get(5)->GetLong(); + } + SvRTLInputBox *pDlg=new SvRTLInputBox(GetpApp()->GetDefModalDialogParent(), + rPrompt,aTitle,aDefault,nX,nY); + pDlg->Execute(); + rPar.Get(0)->PutString( pDlg->GetText() ); + delete pDlg; + } +} + + + diff --git a/basic/source/runtime/iosys.cxx b/basic/source/runtime/iosys.cxx new file mode 100644 index 000000000000..d2861c32ba13 --- /dev/null +++ b/basic/source/runtime/iosys.cxx @@ -0,0 +1,1257 @@ +/************************************************************************* + * + * $RCSfile: iosys.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _SV_DIALOG_HXX //autogen +#include <vcl/dialog.hxx> +#endif +#ifndef _SV_EDIT_HXX //autogen +#include <vcl/edit.hxx> +#endif +#ifndef _SV_BUTTON_HXX //autogen +#include <vcl/button.hxx> +#endif +#ifndef _SV_MSGBOX_HXX //autogen +#include <vcl/msgbox.hxx> +#endif +#ifndef _SV_SVAPP_HXX //autogen +#include <vcl/svapp.hxx> +#endif +#include <osl/security.h> + +#include "runtime.hxx" + +#ifdef _USE_UNO + +// <-- encoding +#ifdef UNX +#include <alloca.h> +#endif +#ifdef WNT +#include <malloc.h> +#define alloca _alloca +#endif +#include <ctype.h> +#include <rtl/byteseq.hxx> +#ifndef _RTL_TEXTENC_H +#include <rtl/textenc.h> +#endif +#ifndef _RTL_USTRBUF_HXX_ +#include <rtl/ustrbuf.hxx> +#endif +#ifndef _RTL_TEXTENC_H +#include <rtl/textenc.h> +#endif +#ifndef _RTL_USTRBUF_HXX_ +#include <rtl/ustrbuf.hxx> +#endif +// encoding --> + +#include <unotools/processfactory.hxx> + +#include <com/sun/star/uno/Sequence.hxx> +#include <com/sun/star/lang/XMultiServiceFactory.hpp> +#include <com/sun/star/ucb/XSimpleFileAccess.hpp> +#include <com/sun/star/io/XInputStream.hpp> +#include <com/sun/star/io/XOutputStream.hpp> +#include <com/sun/star/io/XStream.hpp> +#include <com/sun/star/io/XSeekable.hpp> +#include <com/sun/star/bridge/XBridge.hpp> +#include <com/sun/star/bridge/XBridgeFactory.hpp> + +using namespace utl; +using namespace rtl; +using namespace com::sun::star::uno; +using namespace com::sun::star::lang; +using namespace com::sun::star::ucb; +using namespace com::sun::star::io; +using namespace com::sun::star::bridge; + +#endif /* _USE_UNO */ + +#pragma hdrstop +#include "iosys.hxx" +#include "sbintern.hxx" + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +// Der Input-Dialog: + +class SbiInputDialog : public ModalDialog { + Edit aInput; + OKButton aOk; + CancelButton aCancel; + String aText; + DECL_LINK( Ok, Window * ); + DECL_LINK( Cancel, Window * ); +public: + SbiInputDialog( Window*, const String& ); + const String& GetInput() { return aText; } +}; + +SbiInputDialog::SbiInputDialog( Window* pParent, const String& rPrompt ) + :ModalDialog( pParent, WB_SVLOOK | WB_MOVEABLE | WB_CLOSEABLE ), + aInput( this, WB_SVLOOK | WB_LEFT | WB_BORDER ), + aOk( this ), aCancel( this ) +{ + SetText( rPrompt ); + aOk.SetClickHdl( LINK( this, SbiInputDialog, Ok ) ); + aCancel.SetClickHdl( LINK( this, SbiInputDialog, Cancel ) ); + SetMapMode( MapMode( MAP_APPFONT ) ); + + Point aPt = LogicToPixel( Point( 50, 50 ) ); + Size aSz = LogicToPixel( Size( 145, 65 ) ); + SetPosSizePixel( aPt, aSz ); + aPt = LogicToPixel( Point( 10, 10 ) ); + aSz = LogicToPixel( Size( 120, 12 ) ); + aInput.SetPosSizePixel( aPt, aSz ); + aPt = LogicToPixel( Point( 15, 30 ) ); + aSz = LogicToPixel( Size( 45, 15) ); + aOk.SetPosSizePixel( aPt, aSz ); + aPt = LogicToPixel( Point( 80, 30 ) ); + aSz = LogicToPixel( Size( 45, 15) ); + aCancel.SetPosSizePixel( aPt, aSz ); + + aInput.Show(); + aOk.Show(); + aCancel.Show(); +} + +IMPL_LINK_INLINE_START( SbiInputDialog, Ok, Window *, pWindow ) +{ + aText = aInput.GetText(); + EndDialog( 1 ); + return 0; +} +IMPL_LINK_INLINE_END( SbiInputDialog, Ok, Window *, pWindow ) + +IMPL_LINK_INLINE_START( SbiInputDialog, Cancel, Window *, pWindow ) +{ + EndDialog( 0 ); + return 0; +} +IMPL_LINK_INLINE_END( SbiInputDialog, Cancel, Window *, pWindow ) + +////////////////////////////////////////////////////////////////////////// + +SbiStream::SbiStream() + : pStrm( 0 ) +{ +} + +SbiStream::~SbiStream() +{ + delete pStrm; +} + +// Ummappen eines SvStream-Fehlers auf einen StarBASIC-Code + +void SbiStream::MapError() +{ + if( pStrm ) + switch( pStrm->GetError() ) + { + case SVSTREAM_OK: + nError = 0; break; + case SVSTREAM_FILE_NOT_FOUND: + nError = SbERR_FILE_NOT_FOUND; break; + case SVSTREAM_PATH_NOT_FOUND: + nError = SbERR_PATH_NOT_FOUND; break; + case SVSTREAM_TOO_MANY_OPEN_FILES: + nError = SbERR_TOO_MANY_FILES; break; + case SVSTREAM_ACCESS_DENIED: + nError = SbERR_ACCESS_DENIED; break; + case SVSTREAM_INVALID_PARAMETER: + nError = SbERR_BAD_ARGUMENT; break; + case SVSTREAM_OUTOFMEMORY: + nError = SbERR_NO_MEMORY; break; + default: + nError = SbERR_IO_ERROR; break; + } +} + +#ifdef _USE_UNO + +// TODO: Code is copied from daemons2/source/uno/asciiEncoder.cxx + +namespace basicEncoder +{ + enum EncodeMechanism + { + ENCODE_ALL, + WAS_ENCODED, + NOT_CANONIC + }; + + enum DecodeMechanism + { + NO_DECODE, + DECODE_TO_IURI, + DECODE_WITH_CHARSET + }; + + enum EscapeType + { + ESCAPE_NO, + ESCAPE_OCTET, + ESCAPE_UTF32 + }; + + inline bool isUSASCII(sal_uInt32 nChar) + { + return nChar <= 0x7F; + } + + inline bool isDigit(sal_uInt32 nChar) + { + return nChar >= '0' && nChar <= '9'; + } + + inline int getHexWeight(sal_uInt32 nChar) + { + return isDigit(nChar) ? int(nChar - '0') : + nChar >= 'A' && nChar <= 'F' ? int(nChar - 'A' + 10) : + nChar >= 'a' && nChar <= 'f' ? int(nChar - 'a' + 10) : -1; + } + + inline bool isHighSurrogate(sal_uInt32 nUTF16) + { + return nUTF16 >= 0xD800 && nUTF16 <= 0xDBFF; + } + + inline bool isLowSurrogate(sal_uInt32 nUTF16) + { + return nUTF16 >= 0xDC00 && nUTF16 <= 0xDFFF; + } + + sal_uInt32 getHexDigit(int nWeight) + { + OSL_ASSERT(nWeight >= 0 && nWeight < 16); + static sal_Char const aDigits[16] + = { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', + 'D', 'E', 'F' }; + return aDigits[nWeight]; + } + + inline void appendEscape(rtl::OUStringBuffer & rTheText, + sal_Char cEscapePrefix, sal_uInt32 nOctet) + { + rTheText.append(sal_Unicode(cEscapePrefix)); + rTheText.append(sal_Unicode(getHexDigit(int(nOctet >> 4)))); + rTheText.append(sal_Unicode(getHexDigit(int(nOctet & 15)))); + } + + inline sal_uInt32 getUTF32Character(sal_Unicode const *& rBegin, + sal_Unicode const * pEnd) + { + OSL_ASSERT(rBegin && rBegin < pEnd); + if (rBegin + 1 < pEnd && rBegin[0] >= 0xD800 && rBegin[0] <= 0xDBFF + && rBegin[1] >= 0xDC00 && rBegin[1] <= 0xDFFF) + { + sal_uInt32 nUTF32 = sal_uInt32(*rBegin++ & 0x3FF) << 10; + return (nUTF32 | (*rBegin++ & 0x3FF)) + 0x10000; + } + else + return *rBegin++; + } + + sal_uInt32 getUTF32(sal_Unicode const *& rBegin, sal_Unicode const * pEnd, + bool bOctets, sal_Char cEscapePrefix, + EncodeMechanism eMechanism, rtl_TextEncoding eCharset, + EscapeType & rEscapeType) + { + OSL_ASSERT(rBegin < pEnd); + sal_uInt32 nUTF32 = bOctets ? *rBegin++ : getUTF32Character(rBegin, pEnd); + switch (eMechanism) + { + case ENCODE_ALL: + rEscapeType = ESCAPE_NO; + break; + + case WAS_ENCODED: + { + int nWeight1; + int nWeight2; + if (nUTF32 == cEscapePrefix && rBegin + 1 < pEnd + && (nWeight1 = getHexWeight(rBegin[0])) >= 0 + && (nWeight2 = getHexWeight(rBegin[1])) >= 0) + { + rBegin += 2; + nUTF32 = nWeight1 << 4 | nWeight2; + switch (eCharset) + { + default: + OSL_ASSERT(false); + case RTL_TEXTENCODING_ASCII_US: + rEscapeType + = isUSASCII(nUTF32) ? ESCAPE_UTF32 : ESCAPE_OCTET; + break; + + case RTL_TEXTENCODING_ISO_8859_1: + rEscapeType = ESCAPE_UTF32; + break; + + case RTL_TEXTENCODING_UTF8: + if (isUSASCII(nUTF32)) + rEscapeType = ESCAPE_UTF32; + else + { + if (nUTF32 >= 0xC0 && nUTF32 <= 0xF4) + { + sal_uInt32 nEncoded; + int nShift; + sal_uInt32 nMin; + if (nUTF32 <= 0xDF) + { + nEncoded = (nUTF32 & 0x1F) << 6; + nShift = 0; + nMin = 0x80; + } + else if (nUTF32 <= 0xEF) + { + nEncoded = (nUTF32 & 0x0F) << 12; + nShift = 6; + nMin = 0x800; + } + else + { + nEncoded = (nUTF32 & 0x07) << 18; + nShift = 12; + nMin = 0x10000; + } + sal_Unicode const * p = rBegin; + bool bUTF8 = true; + for (;;) + { + if (p + 2 >= pEnd || p[0] != cEscapePrefix + || (nWeight1 = getHexWeight(p[1])) < 0 + || (nWeight2 = getHexWeight(p[2])) < 0 + || nWeight1 < 8) + { + bUTF8 = false; + break; + } + p += 3; + nEncoded + |= ((nWeight1 & 3) << 4 | nWeight2) + << nShift; + if (nShift == 0) + break; + nShift -= 6; + } + if (bUTF8 && nEncoded >= nMin + && !isHighSurrogate(nEncoded) + && !isLowSurrogate(nEncoded) + && nEncoded <= 0x10FFFF) + { + rBegin = p; + nUTF32 = nEncoded; + rEscapeType = ESCAPE_UTF32; + break; + } + } + rEscapeType = ESCAPE_OCTET; + } + break; + } + } + else + rEscapeType = ESCAPE_NO; + break; + } + + case NOT_CANONIC: + { + int nWeight1; + int nWeight2; + if (nUTF32 == cEscapePrefix && rBegin + 1 < pEnd + && ((nWeight1 = getHexWeight(rBegin[0])) >= 0) + && ((nWeight2 = getHexWeight(rBegin[1])) >= 0)) + { + rBegin += 2; + nUTF32 = nWeight1 << 4 | nWeight2; + rEscapeType = ESCAPE_OCTET; + } + else + rEscapeType = ESCAPE_NO; + break; + } + } + return nUTF32; + } + + static rtl::OUString decodeImpl(sal_Unicode const * pBegin, + sal_Unicode const * pEnd, sal_Char cEscapePrefix, + DecodeMechanism eMechanism, + rtl_TextEncoding eCharset) + { + switch (eMechanism) + { + case NO_DECODE: + return rtl::OUString(pBegin, pEnd - pBegin); + + case DECODE_TO_IURI: + eCharset = RTL_TEXTENCODING_UTF8; + break; + } + rtl::OUStringBuffer aResult; + while (pBegin < pEnd) + { + EscapeType eEscapeType; + sal_uInt32 nUTF32 = getUTF32(pBegin, pEnd, false, cEscapePrefix, + WAS_ENCODED, eCharset, eEscapeType); + switch (eEscapeType) + { + case ESCAPE_NO: + aResult.append(sal_Unicode(nUTF32)); + break; + + case ESCAPE_OCTET: + appendEscape(aResult, cEscapePrefix, nUTF32); + break; + + case ESCAPE_UTF32: + if (eMechanism == DECODE_TO_IURI && isUSASCII(nUTF32)) + appendEscape(aResult, cEscapePrefix, nUTF32); + else + aResult.append(sal_Unicode(nUTF32)); + break; + } + } + return aResult.makeStringAndClear(); + } + + + OUString AsciiEncoder::decodeUnoUrlParamValue(rtl::OUString const & rSource) + { + return decodeImpl(rSource.getStr(), rSource.getStr() + rSource.getLength(), + '%', DECODE_WITH_CHARSET, RTL_TEXTENCODING_UTF8); + } + +} + + +OUString findUserInDescription( const OUString& aDescription ) +{ + OUString user; + + sal_Int32 index; + sal_Int32 lastIndex = 0; + +//#ifdef DEBUG + //OString tmp = OUStringToOString(aDescription, RTL_TEXTENCODING_ASCII_US); + //OSL_TRACE("Portal_XConnector %s\n", tmp.getStr()); +//#endif + + do + { + index = aDescription.indexOf((sal_Unicode) ',', lastIndex); + //OSL_TRACE("Portal_XConnector %d last_index %d\n", index, lastIndex); + OUString token = (index == -1) ? aDescription.copy(lastIndex) : aDescription.copy(lastIndex, index - lastIndex); + +//#ifdef DEBUG + //OString token_tmp = OUStringToOString(token, RTL_TEXTENCODING_ASCII_US); + //OSL_TRACE("Portal_XConnector - token %s\n", token_tmp.getStr()); +//#endif + + lastIndex = index + 1; + + sal_Int32 eindex = token.indexOf((sal_Unicode)'='); + OUString left = token.copy(0, eindex).toLowerCase().trim(); + OUString right = basicEncoder::AsciiEncoder::decodeUnoUrlParamValue(token.copy(eindex + 1).trim()); + +//#ifdef DEBUG + //OString left_tmp = OUStringToOString(left, RTL_TEXTENCODING_ASCII_US); + //OSL_TRACE("Portal_XConnector - left %s\n", left_tmp.getStr()); + //OString right_tmp = OUStringToOString(right, RTL_TEXTENCODING_ASCII_US); + //OSL_TRACE("Portal_XConnector - right %s\n", right_tmp.getStr()); +//#endif + + if(left.equals(OUString(RTL_CONSTASCII_USTRINGPARAM("user")))) + { + user = right; + break; + } + } + while(index != -1); + + return user; + + /* + ORef<IPortalConnector> connector; + + Reference<XConnection> xConnection; + + OUString protocol; + connector = getPortalConnector(protocol); + if(connector.isValid()) + { + ORef<IConnection> connection; + + OUString server; + if(host.getLength()) // let the server empty when there is no host + { + server += host; + server += OUString(RTL_CONSTASCII_USTRINGPARAM(":")); + server += port; + } + + RC state; + + if(user.getLength() && !ticket.getLength()) // if there is a user and no ticket + { + state = connector->connectToService(user, password, server, service, connection); + } + else + { + ByteSequence byteSequence_ticket = AsciiEncoder::decode(ticket); + + state = connector->connectToService(user, byteSequence_ticket, server, service, connection); + } + + if(state == E_None) + xConnection = new Portal_XConnection(connection); + else + throw ConnectionSetupException(OUString(RTL_CONSTASCII_USTRINGPARAM("Portal_XConnector::connect: could not connect")), Reference<XInterface>()); + } + else + throw ConnectionSetupException(OUString(RTL_CONSTASCII_USTRINGPARAM("Portal_XConnector::connect: couldn't get connector")), Reference<XInterface>()); + + return xConnection; + */ +} + +#endif + + + +BOOL needSecurityRestrictions( void ) +{ +#ifdef _USE_UNO + static BOOL bNeedInit = TRUE; + static BOOL bRetVal = TRUE; + + if( bNeedInit ) + { + bNeedInit = FALSE; + + // Get system user to compare to portal user + oslSecurity aSecurity = osl_getCurrentSecurity(); + OUString aSystemUser; + sal_Bool bRet = osl_getUserName( aSecurity, &aSystemUser.pData ); + if( !bRet ) + { + // No valid security! -> Secure mode! + return TRUE; + } + + Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory(); + if( !xSMgr.is() ) + return TRUE; + Reference< XBridgeFactory > xBridgeFac( xSMgr->createInstance + ( OUString::createFromAscii( "com.sun.star.bridge.BridgeFactory" ) ), UNO_QUERY ); + + Sequence< Reference< XBridge > > aBridgeSeq; + sal_Int32 nBridgeCount = 0; + if( xBridgeFac.is() ) + { + aBridgeSeq = xBridgeFac->getExistingBridges(); + nBridgeCount = aBridgeSeq.getLength(); + } + + if( nBridgeCount == 0 ) + { + // No bridges -> local + bRetVal = FALSE; + return bRetVal; + } + + // Iterate through all bridges to find (portal) user property + const Reference< XBridge >* pBridges = aBridgeSeq.getConstArray(); + bRetVal = FALSE; // Now only TRUE if user different from portal user is found + sal_Int32 i; + for( i = 0 ; i < nBridgeCount ; i++ ) + { + const Reference< XBridge >& rxBridge = pBridges[ i ]; + OUString aDescription = rxBridge->getDescription(); + OUString aPortalUser = findUserInDescription( aDescription ); + if( aPortalUser.getLength() > 0 ) + { + // User Found, compare to system user + if( aPortalUser == aSystemUser ) + { + // Same user -> system security is ok, bRetVal stays FALSE + break; + } + else + { + // Different user -> Secure mode! + bRetVal = TRUE; + break; + } + } + } + // No user found or PortalUser != SystemUser -> Secure mode! (Keep default value) + } + + return bRetVal; +#else + return FALSE; +#endif +} + +// Returns TRUE if UNO is available, otherwise the old +// file system implementation has to be used +// (Implemented in iosys.cxx) +BOOL hasUno( void ) +{ +#ifdef _USE_UNO + static BOOL bNeedInit = TRUE; + static BOOL bRetVal = TRUE; + + if( bNeedInit ) + { + bNeedInit = FALSE; + Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory(); + if( !xSMgr.is() ) + bRetVal = FALSE; + } + return bRetVal; +#else + return FALSE; +#endif +} + + +#ifdef _USE_UNO + +class UCBStream : public SvStream +{ + Reference< XInputStream > xIS; + Reference< XOutputStream > xOS; + Reference< XStream > xS; + Reference< XSeekable > xSeek; +public: + UCBStream( Reference< XInputStream > & xIS ); + UCBStream( Reference< XOutputStream > & xOS ); + UCBStream( Reference< XStream > & xS ); + ~UCBStream(); + virtual ULONG GetData( void* pData, ULONG nSize ); + virtual ULONG PutData( const void* pData, ULONG nSize ); + virtual ULONG SeekPos( ULONG nPos ); + virtual void FlushData(); + virtual void SetSize( ULONG nSize ); +}; + +/* +ULONG UCBErrorToSvStramError( ucb::IOErrorCode nError ) +{ + ULONG eReturn = ERRCODE_IO_GENERAL; + switch( nError ) + { + case ucb::IOErrorCode_ABORT: eReturn = SVSTREAM_GENERALERROR; break; + case ucb::IOErrorCode_NOT_EXISTING: eReturn = SVSTREAM_FILE_NOT_FOUND; break; + case ucb::IOErrorCode_NOT_EXISTING_PATH: eReturn = SVSTREAM_PATH_NOT_FOUND; break; + case ucb::IOErrorCode_OUT_OF_FILE_HANDLES: eReturn = SVSTREAM_TOO_MANY_OPEN_FILES; break; + case ucb::IOErrorCode_ACCESS_DENIED: eReturn = SVSTREAM_ACCESS_DENIED; break; + case ucb::IOErrorCode_LOCKING_VIOLATION: eReturn = SVSTREAM_SHARING_VIOLATION; break; + + case ucb::IOErrorCode_INVALID_ACCESS: eReturn = SVSTREAM_INVALID_ACCESS; break; + case ucb::IOErrorCode_CANT_CREATE: eReturn = SVSTREAM_CANNOT_MAKE; break; + case ucb::IOErrorCode_INVALID_PARAMETER: eReturn = SVSTREAM_INVALID_PARAMETER; break; + + case ucb::IOErrorCode_CANT_READ: eReturn = SVSTREAM_READ_ERROR; break; + case ucb::IOErrorCode_CANT_WRITE: eReturn = SVSTREAM_WRITE_ERROR; break; + case ucb::IOErrorCode_CANT_SEEK: eReturn = SVSTREAM_SEEK_ERROR; break; + case ucb::IOErrorCode_CANT_TELL: eReturn = SVSTREAM_TELL_ERROR; break; + + case ucb::IOErrorCode_OUT_OF_MEMORY: eReturn = SVSTREAM_OUTOFMEMORY; break; + + case SVSTREAM_FILEFORMAT_ERROR: eReturn = SVSTREAM_FILEFORMAT_ERROR; break; + case ucb::IOErrorCode_WRONG_VERSION: eReturn = SVSTREAM_WRONGVERSION; + case ucb::IOErrorCode_OUT_OF_DISK_SPACE: eReturn = SVSTREAM_DISK_FULL; break; + + case ucb::IOErrorCode_BAD_CRC: eReturn = ERRCODE_IO_BADCRC; break; + } + return eReturn; +} +*/ + +UCBStream::UCBStream( Reference< XInputStream > & rStm ) + : xIS( rStm ) + , xSeek( rStm, UNO_QUERY ) +{ +} + +UCBStream::UCBStream( Reference< XOutputStream > & rStm ) + : xOS( rStm ) + , xSeek( rStm, UNO_QUERY ) +{ +} + +UCBStream::UCBStream( Reference< XStream > & rStm ) + : xS( rStm ) + , xSeek( rStm, UNO_QUERY ) +{ +} + + +UCBStream::~UCBStream() +{ + try + { + if( xIS.is() ) + xIS->closeInput(); + else if( xOS.is() ) + xOS->closeOutput(); + else if( xS.is() ) + xS->closeStream(); + } + catch( Exception & ) + { + SetError( ERRCODE_IO_GENERAL ); + } +} + +ULONG UCBStream::GetData( void* pData, ULONG nSize ) +{ + try + { + if( xIS.is() ) + { + Sequence<sal_Int8> aData; + nSize = xIS->readBytes( aData, nSize ); + rtl_copyMemory( pData, aData.getConstArray(), nSize ); + return nSize; + } + else if( xS.is() ) + { + Sequence<sal_Int8> aData; + nSize = xS->readBytes( aData, nSize ); + rtl_copyMemory( pData, aData.getConstArray(), nSize ); + return nSize; + } + else + SetError( ERRCODE_IO_GENERAL ); + } + catch( Exception & ) + { + SetError( ERRCODE_IO_GENERAL ); + } + return 0; +} + +ULONG UCBStream::PutData( const void* pData, ULONG nSize ) +{ + try + { + if( xOS.is() ) + { + Sequence<sal_Int8> aData( (const sal_Int8 *)pData, nSize ); + xOS->writeBytes( aData ); + return nSize; + } + else if( xS.is() ) + { + Sequence<sal_Int8> aData( (const sal_Int8 *)pData, nSize ); + xS->writeBytes( aData ); + return nSize; + } + else + SetError( ERRCODE_IO_GENERAL ); + } + catch( Exception & ) + { + SetError( ERRCODE_IO_GENERAL ); + } + return 0; +} + +ULONG UCBStream::SeekPos( ULONG nPos ) +{ + if( !nPos ) + return 0; + try + { + if( xSeek.is() ) + { + sal_Int32 nLen = xSeek->getLength(); + if( nPos > nLen ) + nPos = nLen; + xSeek->seek( nPos ); + return nPos; + } + else + SetError( ERRCODE_IO_GENERAL ); + } + catch( Exception & ) + { + SetError( ERRCODE_IO_GENERAL ); + } + return 0; +} + +void UCBStream::FlushData() +{ + try + { + if( xOS.is() ) + xOS->flush(); + else if( xS.is() ) + xS->flush(); + else + SetError( ERRCODE_IO_GENERAL ); + } + catch( Exception & ) + { + SetError( ERRCODE_IO_GENERAL ); + } +} + +void UCBStream::SetSize( ULONG nSize ) +{ + DBG_ERROR( "not allowed to call from basic" ) + SetError( ERRCODE_IO_GENERAL ); +} + +#endif + +// Oeffnen eines Streams +SbError SbiStream::Open +( short nCh, const ByteString& rName, short nStrmMode, short nFlags, short nL ) +{ + nMode = nFlags; + nLen = nL; + nChan = nCh; + nLine = 0; + nExpandOnWriteTo = 0; + if( ( nStrmMode & ( STREAM_READ|STREAM_WRITE ) ) == STREAM_READ ) + nStrmMode |= STREAM_NOCREATE; + String aNameStr( rName, gsl_getSystemTextEncoding() ); +#ifdef _USE_UNO + if( hasUno() ) + { + Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory(); + if( xSMgr.is() ) + { + Reference< XSimpleFileAccess > + xSFI( xSMgr->createInstance( OUString::createFromAscii( "com.sun.star.ucb.SimpleFileAccess" ) ), UNO_QUERY ); + if( xSFI.is() ) + { + try + { + + if( (nStrmMode & (STREAM_READ | STREAM_WRITE)) == (STREAM_READ | STREAM_WRITE) ) + { + Reference< XStream > xIS = xSFI->openFileReadWrite( aNameStr ); + pStrm = new UCBStream( xIS ); + } + else if( nStrmMode & STREAM_WRITE ) + { + Reference< XStream > xIS = xSFI->openFileReadWrite( aNameStr ); + pStrm = new UCBStream( xIS ); + // Open for writing is not implemented in ucb yet!!! + //Reference< XOutputStream > xIS = xSFI->openFileWrite( aNameStr ); + //pStrm = new UCBStream( xIS ); + } + else //if( nStrmMode & STREAM_READ ) + { + Reference< XInputStream > xIS = xSFI->openFileRead( aNameStr ); + pStrm = new UCBStream( xIS ); + } + } + catch( Exception & ) + { + } + } + } + } + +#endif + if( !pStrm ) + pStrm = new SvFileStream( aNameStr, nStrmMode ); + if( IsAppend() ) + pStrm->Seek( STREAM_SEEK_TO_END ); + MapError(); + if( nError ) + delete pStrm, pStrm = NULL; + return nError; +} + +SbError SbiStream::Close() +{ + if( pStrm ) + { + if( !hasUno() ) + ((SvFileStream *)pStrm)->Close(); + MapError(); + delete pStrm; + pStrm = NULL; + } + nChan = 0; + return nError; +} + +SbError SbiStream::Read( ByteString& rBuf, USHORT n ) +{ + nExpandOnWriteTo = 0; + if( IsText() ) + { + pStrm->ReadLine( rBuf ); + nLine++; + } + else + { + if( !n ) n = nLen; + if( !n ) + return nError = SbERR_BAD_RECORD_LENGTH; + rBuf.Fill( n, ' ' ); + pStrm->Read( (void*)rBuf.GetBuffer(), n ); + } + MapError(); + if( !nError && pStrm->IsEof() ) + nError = SbERR_READ_PAST_EOF; + return nError; +} + +SbError SbiStream::Read( char& ch ) +{ + nExpandOnWriteTo = 0; + if( !aLine.Len() ) + { + Read( aLine, 0 ); + aLine += '\n'; + } + ch = aLine.GetBuffer()[0]; + aLine.Erase( 0, 1 ); + return nError; +} + +void SbiStream::ExpandFile() +{ + if ( nExpandOnWriteTo ) + { + ULONG nCur = pStrm->Seek(STREAM_SEEK_TO_END); + if( nCur < nExpandOnWriteTo ) + { + ULONG nDiff = nExpandOnWriteTo - nCur; + char c = 0; + while( nDiff-- ) + *pStrm << c; + } + else + { + pStrm->Seek( nExpandOnWriteTo ); + } + nExpandOnWriteTo = 0; + } +} + +SbError SbiStream::Write( const ByteString& rBuf, USHORT n ) +{ + ExpandFile(); + if( IsAppend() ) + pStrm->Seek( STREAM_SEEK_TO_END ); + + if( IsText() ) + { + aLine += rBuf; + // Raus damit, wenn das Ende ein LF ist, aber CRLF vorher + // strippen, da der SvStrm ein CRLF anfuegt! + USHORT n = aLine.Len(); + if( n && aLine.GetBuffer()[ --n ] == 0x0A ) + { + aLine.Erase( n ); + if( n && aLine.GetBuffer()[ --n ] == 0x0D ) + aLine.Erase( n ); + pStrm->WriteLines( aLine ); + aLine.Erase(); + } + } + else + { + if( !n ) n = nLen; + if( !n ) + return nError = SbERR_BAD_RECORD_LENGTH; + pStrm->Write( rBuf.GetBuffer(), n ); + MapError(); + } + return nError; +} + +////////////////////////////////////////////////////////////////////////// + +// Zugriff auf das aktuelle I/O-System: + +SbiIoSystem* SbGetIoSystem() +{ + SbiInstance* pInst = pINST; + return pInst ? pInst->GetIoSystem() : NULL; +} + +////////////////////////////////////////////////////////////////////////// + +SbiIoSystem::SbiIoSystem() +{ + for( short i = 0; i < CHANNELS; i++ ) + pChan[ i ] = NULL; + nChan = 0; + nError = 0; +} + +SbiIoSystem::~SbiIoSystem() +{ + Shutdown(); +} + +SbError SbiIoSystem::GetError() +{ + SbError n = nError; nError = 0; + return n; +} + +void SbiIoSystem::Open + ( short nCh, const ByteString& rName, short nMode, short nFlags, short nLen ) +{ + nError = 0; + if( nCh >= CHANNELS || !nCh ) + nError = SbERR_BAD_CHANNEL; + else if( pChan[ nCh ] ) + nError = SbERR_FILE_ALREADY_OPEN; + else + { + pChan[ nCh ] = new SbiStream; + nError = pChan[ nCh ]->Open( nCh, rName, nMode, nFlags, nLen ); + if( nError ) + delete pChan[ nCh ], pChan[ nCh ] = NULL; + } + nChan = 0; +} + +// Aktuellen Kanal schliessen + +void SbiIoSystem::Close() +{ + if( !nChan ) + nError = SbERR_BAD_CHANNEL; + else if( !pChan[ nChan ] ) + nError = SbERR_BAD_CHANNEL; + else + { + nError = pChan[ nChan ]->Close(); + delete pChan[ nChan ]; + pChan[ nChan ] = NULL; + } + nChan = 0; +} + +// Shutdown nach Programmlauf + +void SbiIoSystem::Shutdown() +{ + for( short i = 1; i < CHANNELS; i++ ) + { + if( pChan[ i ] ) + { + USHORT n = pChan[ i ]->Close(); + delete pChan[ i ]; + pChan[ i ] = NULL; + if( n && !nError ) + nError = n; + } + } + nChan = 0; + // Noch was zu PRINTen? + if( aOut.Len() ) + { + String aOutStr( aOut, gsl_getSystemTextEncoding() ); +#if defined GCC + Window* pParent = Application::GetDefModalDialogParent(); + MessBox( pParent, WinBits( WB_OK ), String(), aOutStr ).Execute(); +#else + MessBox( GetpApp()->GetDefModalDialogParent(), WinBits( WB_OK ), String(), aOutStr ).Execute(); +#endif + } + aOut.Erase(); +} + +// Aus aktuellem Kanal lesen + +void SbiIoSystem::Read( ByteString& rBuf, short n ) +{ + if( !nChan ) + ReadCon( rBuf ); + else if( !pChan[ nChan ] ) + nError = SbERR_BAD_CHANNEL; + else + nError = pChan[ nChan ]->Read( rBuf, n ); +} + +char SbiIoSystem::Read() +{ + char ch = ' '; + if( !nChan ) + { + if( !aIn.Len() ) + { + ReadCon( aIn ); + aIn += '\n'; + } + ch = aIn.GetBuffer()[0]; + aIn.Erase( 0, 1 ); + } + else if( !pChan[ nChan ] ) + nError = SbERR_BAD_CHANNEL; + else + nError = pChan[ nChan ]->Read( ch ); + return ch; +} + +void SbiIoSystem::Write( const ByteString& rBuf, short n ) +{ + if( !nChan ) + WriteCon( rBuf ); + else if( !pChan[ nChan ] ) + nError = SbERR_BAD_CHANNEL; + else + nError = pChan[ nChan ]->Write( rBuf, n ); +} + +short SbiIoSystem::NextChannel() +{ + for( short i = 1; i < CHANNELS; i++ ) + { + if( !pChan[ i ] ) + return i; + } + nError = SbERR_TOO_MANY_FILES; + return CHANNELS; +} + +// nChannel == 0..CHANNELS-1 + +SbiStream* SbiIoSystem::GetStream( short nChannel ) const +{ + SbiStream* pRet = 0; + if( nChannel >= 0 && nChannel < CHANNELS ) + pRet = pChan[ nChannel ]; + return pRet; +} + +void SbiIoSystem::CloseAll(void) +{ + for( short i = 1; i < CHANNELS; i++ ) + { + if( pChan[ i ] ) + { + USHORT n = pChan[ i ]->Close(); + delete pChan[ i ]; + pChan[ i ] = NULL; + if( n && !nError ) + nError = n; + } + } +} + +/*************************************************************************** +* +* Console Support +* +***************************************************************************/ + +// Einlesen einer Zeile von der Console + +void SbiIoSystem::ReadCon( ByteString& rIn ) +{ + String aPromptStr( aPrompt, gsl_getSystemTextEncoding() ); + SbiInputDialog aDlg( NULL, aPromptStr ); + if( aDlg.Execute() ) + rIn = ByteString( aDlg.GetInput(), gsl_getSystemTextEncoding() ); + else + nError = SbERR_USER_ABORT; + aPrompt.Erase(); +} + +// Ausgabe einer MessageBox, wenn im Console-Puffer ein CR ist + +void SbiIoSystem::WriteCon( const ByteString& rText ) +{ + aOut += rText; + USHORT n1 = aOut.Search( '\n' ); + USHORT n2 = aOut.Search( '\r' ); + if( n1 != STRING_NOTFOUND || n2 != STRING_NOTFOUND ) + { + if( n1 == STRING_NOTFOUND ) n1 = n2; + else + if( n2 == STRING_NOTFOUND ) n2 = n1; + if( n1 > n2 ) n1 = n2; + ByteString s( aOut.Copy( 0, n1 ) ); + aOut.Erase( 0, n1 ); + while( aOut.GetBuffer()[0] == '\n' || aOut.GetBuffer()[0] == '\r' ) + aOut.Erase( 0, 1 ); + String aStr( s, RTL_TEXTENCODING_ASCII_US ); + if( !MessBox( GetpApp()->GetDefModalDialogParent(), + WinBits( WB_OK_CANCEL | WB_DEF_OK ), + String(), aStr ).Execute() ) + nError = SbERR_USER_ABORT; + } +} + diff --git a/basic/source/runtime/makefile.mk b/basic/source/runtime/makefile.mk new file mode 100644 index 000000000000..24e9e1016f6d --- /dev/null +++ b/basic/source/runtime/makefile.mk @@ -0,0 +1,116 @@ +#************************************************************************* +# +# $RCSfile: makefile.mk,v $ +# +# $Revision: 1.1.1.1 $ +# +# last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ +# +# The Contents of this file are made available subject to the terms of +# either of the following licenses +# +# - GNU Lesser General Public License Version 2.1 +# - Sun Industry Standards Source License Version 1.1 +# +# Sun Microsystems Inc., October, 2000 +# +# GNU Lesser General Public License Version 2.1 +# ============================================= +# Copyright 2000 by Sun Microsystems, Inc. +# 901 San Antonio Road, Palo Alto, CA 94303, USA +# +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License version 2.1, as published by the Free Software Foundation. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, +# MA 02111-1307 USA +# +# +# Sun Industry Standards Source License Version 1.1 +# ================================================= +# The contents of this file are subject to the Sun Industry Standards +# Source License Version 1.1 (the "License"); You may not use this file +# except in compliance with the License. You may obtain a copy of the +# License at http://www.openoffice.org/license.html. +# +# Software provided under this License is provided on an "AS IS" basis, +# WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, +# WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, +# MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. +# See the License for the specific provisions governing your rights and +# obligations concerning the Software. +# +# The Initial Developer of the Original Code is: Sun Microsystems, Inc. +# +# Copyright: 2000 by Sun Microsystems, Inc. +# +# All Rights Reserved. +# +# Contributor(s): _______________________________________ +# +# +# +#************************************************************************* + +PRJ=..$/.. + +PRJNAME=BASIC +TARGET=runtime + +# --- Settings ----------------------------------------------------------- + +.INCLUDE : svpre.mk +.INCLUDE : settings.mk +.INCLUDE : sv.mk + +.IF "$(GUI)" == "WNT" +ASM=masm386 +.ENDIF + + +# --- Allgemein ----------------------------------------------------------- + +SLOFILES= \ + $(SLO)$/basrdll.obj \ + $(SLO)$/inputbox.obj \ + $(SLO)$/runtime.obj \ + $(SLO)$/step0.obj \ + $(SLO)$/step1.obj \ + $(SLO)$/step2.obj \ + $(SLO)$/iosys.obj \ + $(SLO)$/stdobj.obj \ + $(SLO)$/stdobj1.obj \ + $(SLO)$/methods.obj \ + $(SLO)$/methods1.obj \ + $(SLO)$/props.obj \ + $(SLO)$/ddectrl.obj \ + $(SLO)$/dllmgr.obj + +.IF "$(GUI)$(CPU)" == "WINI" +SLOFILES+= $(SLO)$/win.obj +.ENDIF + +.IF "$(GUI)$(CPU)" == "WNTI" +SLOFILES+= $(SLO)$/wnt.obj +.ENDIF + +.IF "$(GUI)$(CPU)" == "OS2I" +SLOFILES+= $(SLO)$/os2.obj +.ENDIF + +EXCEPTIONSFILES=$(SLO)$/step0.obj \ + $(SLO)$/step2.obj \ + $(SLO)$/methods.obj \ + $(SLO)$/iosys.obj + +# --- Targets ------------------------------------------------------------- + +.INCLUDE : target.mk diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx new file mode 100644 index 000000000000..e3a47cba275c --- /dev/null +++ b/basic/source/runtime/methods.cxx @@ -0,0 +1,3228 @@ +/************************************************************************* + * + * $RCSfile: methods.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + + +#ifndef _DATE_HXX //autogen +#include <tools/date.hxx> +#endif +#ifndef _SBXVAR_HXX +#include <svtools/sbxvar.hxx> +#endif +#ifndef _FSYS_HXX //autogen +#include <tools/fsys.hxx> +#endif +#ifndef _INTN_HXX //autogen +#include <tools/intn.hxx> +#endif +#ifndef _VOS_PROCESS_HXX +#include <vos/process.hxx> +#endif +#ifndef _SV_SVAPP_HXX //autogen +#include <vcl/svapp.hxx> +#endif +#ifndef _SV_SOUND_HXX //autogen +#include <vcl/sound.hxx> +#endif +#ifndef _SV_WINTYPES_HXX //autogen +#include <vcl/wintypes.hxx> +#endif +#ifndef _SV_MSGBOX_HXX //autogen +#include <vcl/msgbox.hxx> +#endif +#ifndef _SBXCLASS_HXX //autogen +#include <svtools/sbx.hxx> +#endif +#ifndef _ZFORLIST_HXX //autogen +#include <svtools/zforlist.hxx> +#endif +#ifndef _TOOLS_SOLMATH_HXX //autogen wg. SolarMath +#include <tools/solmath.hxx> +#endif +#include <tools/urlobj.hxx> +#include <osl/file.hxx> + +#ifdef OS2 +#define INCL_WINWINDOWMGR +#define INCL_DOS +#endif + +#if defined (WNT) +#ifndef _SVWIN_H +#include <tools/svwin.h> +#endif +#endif +#if defined (OS2) +#ifndef _SVPM_H +#include <tools/svpm.h> +#endif +#endif + +#pragma hdrstop +#include "runtime.hxx" + +#ifdef _USE_UNO +#include <unotools/processfactory.hxx> + +#include <com/sun/star/uno/Sequence.hxx> +#include <com/sun/star/util/DateTime.hpp> +#include <com/sun/star/lang/XMultiServiceFactory.hpp> +#include <com/sun/star/ucb/XSimpleFileAccess.hpp> +#include <com/sun/star/io/XInputStream.hpp> +#include <com/sun/star/io/XOutputStream.hpp> +#include <com/sun/star/io/XStream.hpp> +#include <com/sun/star/io/XSeekable.hpp> + +using namespace utl; +using namespace rtl; +using namespace osl; +using namespace com::sun::star::uno; +using namespace com::sun::star::lang; +using namespace com::sun::star::ucb; +using namespace com::sun::star::io; + +#endif /* _USE_UNO */ + +#include "stdobj.hxx" +#include "stdobj1.hxx" +#include "rtlproto.hxx" +#include "basrid.hxx" +#include "sb.hrc" +#ifndef _SBIOSYS_HXX +#include "iosys.hxx" +#endif +#ifndef _DDECTRL_HXX +#include "ddectrl.hxx" +#endif +#include <sbintern.hxx> + +#include <stl/list> +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <ctype.h> + +#if defined (WIN) || defined (WNT) || defined (OS2) +#include <direct.h> // _getdcwd get current work directory, _chdrive +#endif + +#ifdef WIN +#include <dos.h> // _dos_getfileattr +#include <errno.h> +#endif + +#ifdef UNX +#include <errno.h> +#include <unistd.h> +#endif + +#ifdef WNT +#include <io.h> +#endif + +#ifdef MAC +#include <mac_start.h> + +#ifndef __FILES__ + #include <Files.h> +#endif + +#ifndef __ERRORS__ + #include <Errors.h> +#endif + +#include <MAC_TOOLS.hxx> +#include <mac_end.h> +#endif + +//#include <numbers.hxx> + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + + +#if defined (OS2) && defined (__BORLANDC__) +#pragma option -w-par +#endif + +static void FilterWhiteSpace( String& rStr ) +{ + rStr.EraseAllChars( ' ' ); + rStr.EraseAllChars( '\t' ); + rStr.EraseAllChars( '\n' ); + rStr.EraseAllChars( '\r' ); +} + +static long GetDayDiff( const Date& rDate ) +{ + Date aRefDate( 1,1,1900 ); + long nDiffDays; + if ( aRefDate > rDate ) + { + nDiffDays = (long)(aRefDate - rDate); + nDiffDays *= -1; + } + else + nDiffDays = (long)(rDate - aRefDate); + nDiffDays += 2; // Anpassung VisualBasic: 1.Jan.1900 == 2 + return nDiffDays; +} + + +//*** UCB file access *** +// Converts possibly relative paths to absolute paths +// according to the setting done by ChDir/ChDrive +// (Implemented in methods.cxx) +String getFullPath( const String& aRelPath ) +{ + // TODO: Use CurDir to build full path + // First step: Return given path unchanged + return aRelPath; +} + +// Sets (virtual) current path for UCB file access +void implChDir( const String& aDir ) +{ + // TODO +} + +// Sets (virtual) current drive for UCB file access +void implChDrive( const String& aDrive ) +{ + // TODO +} + +// Returns (virtual) current path for UCB file access +String implGetCurDir( void ) +{ + String aRetStr; + + return aRetStr; +} + +// TODO: -> SbiGlobals +static Reference< XSimpleFileAccess > getFileAccess( void ) +{ + static Reference< XSimpleFileAccess > xSFI; + if( !xSFI.is() ) + { + Reference< XMultiServiceFactory > xSMgr = getProcessServiceFactory(); + if( xSMgr.is() ) + { + xSFI = Reference< XSimpleFileAccess >( xSMgr->createInstance + ( OUString::createFromAscii( "com.sun.star.ucb.SimpleFileAccess" ) ), UNO_QUERY ); + } + } + return xSFI; +} + + + + +// Properties und Methoden legen beim Get (bPut = FALSE) den Returnwert +// im Element 0 des Argv ab; beim Put (bPut = TRUE) wird der Wert aus +// Element 0 gespeichert. + +// CreateObject( class ) + +RTLFUNC(CreateObject) +{ + String aClass( rPar.Get( 1 )->GetString() ); + SbxObjectRef p = SbxBase::CreateObject( aClass ); + if( !p ) + StarBASIC::Error( SbERR_CANNOT_LOAD ); + else + { + // Convenience: BASIC als Parent eintragen + p->SetParent( pBasic ); + rPar.Get( 0 )->PutObject( p ); + } +} + +// Error( n ) + +RTLFUNC(Error) +{ + if( !pBasic ) + StarBASIC::Error( SbERR_INTERNAL_ERROR ); + else + { + String aErrorMsg; + SbError nErr = 0L; + if( rPar.Count() == 1 ) + { + nErr = StarBASIC::GetErr(); + aErrorMsg = StarBASIC::GetErrorMsg(); + } + else + { + INT32 nCode = rPar.Get( 1 )->GetLong(); + if( nCode > 65535L ) + StarBASIC::Error( SbERR_CONVERSION ); + else + nErr = StarBASIC::GetSfxFromVBError( (USHORT)nCode ); + } + pBasic->MakeErrorText( nErr, aErrorMsg ); + rPar.Get( 0 )->PutString( pBasic->GetErrorText() ); + } +} + +// Sinus + +RTLFUNC(Sin) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + rPar.Get( 0 )->PutDouble( sin( pArg->GetDouble() ) ); + } +} + +// Cosinus + +RTLFUNC(Cos) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + rPar.Get( 0 )->PutDouble( cos( pArg->GetDouble() ) ); + } +} + +// Atn + +RTLFUNC(Atn) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + rPar.Get( 0 )->PutDouble( atan( pArg->GetDouble() ) ); + } +} + + + +RTLFUNC(Abs) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + rPar.Get( 0 )->PutDouble( fabs( pArg->GetDouble() ) ); + } +} + + +RTLFUNC(Asc) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + String aStr( pArg->GetString() ); + if ( aStr.Len() == 0 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + rPar.Get(0)->PutEmpty(); + } + else + { + sal_Unicode aCh = aStr.GetBuffer()[0]; + rPar.Get(0)->PutInteger( (INT16)aCh ); + } + } +} + +RTLFUNC(Chr) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + char aCh = (char) pArg->GetInteger(); + String aStr; + aStr = aCh; + rPar.Get(0)->PutString( aStr ); + } +} + + +#ifdef UNX +#define _MAX_PATH 260 +#define _PATH_INCR 250 +#endif + +RTLFUNC(CurDir) +{ + // #57064 Obwohl diese Funktion nicht mit DirEntry arbeitet, ist sie von + // der Anpassung an virtuelle URLs nich betroffen, da bei Nutzung der + // DirEntry-Funktionalitaet keine Moeglichkeit besteht, das aktuelle so + // zu ermitteln, dass eine virtuelle URL geliefert werden koennte. + +// rPar.Get(0)->PutEmpty(); +#if defined (WIN) || defined (WNT) || (defined (OS2) && !defined( WTC )) + int nCurDir = 0; // Current dir // JSM + if ( rPar.Count() == 2 ) + { + String aDrive = rPar.Get(1)->GetString(); + if ( aDrive.Len() != 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + else + { + nCurDir = (int)aDrive.GetBuffer()[0]; + if ( !isalpha( nCurDir ) ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + else + nCurDir -= ( 'A' - 1 ); + } + } + char* pBuffer = new char[ _MAX_PATH ]; +#ifdef MTW + int old = _getdrive(); + _chdrive(nCurDir); + + if ( getcwd( pBuffer, _MAX_PATH ) != 0 ) + rPar.Get(0)->PutString( String::CreateFromAscii( pBuffer ) ); + else + StarBASIC::Error( SbERR_NO_DEVICE ); + delete pBuffer; + _chdrive(old); +#else +#ifdef OS2 + if( !nCurDir ) + nCurDir = _getdrive(); +#endif + if ( _getdcwd( nCurDir, pBuffer, _MAX_PATH ) != 0 ) + rPar.Get(0)->PutString( String::CreateFromAscii( pBuffer ) ); + else + StarBASIC::Error( SbERR_NO_DEVICE ); + delete pBuffer; +#endif + +#elif defined MAC + + Str255 aBuffer; + FSSpec aFileSpec; // Pseudofile + String aPar1; + OSErr nErr; + + // Erstmal aktuelle Pfad bestimmen + nErr = FSMakeFSSpec(0,0,"\p:X",&aFileSpec); + + PathNameFromDirID( aFileSpec.parID,aFileSpec.vRefNum, (char*) aBuffer); + String aPath((char*) &aBuffer[1],aBuffer[0]); + + if ( rPar.Count() == 2 ) + { + aPar1 = rPar.Get(1)->GetString(); + + // Wen kein ':' drin ist dann haengen wir (netterweise) einen an + if (aPar1.Search(':') == STRING_NOTFOUND) + aPar1 += ':'; + USHORT nFirstColon = aPar1.Search(':'); + if (!aPar1.Len() || + nFirstColon != (aPar1.Len() - 1)) + // Kein ':' am Ende oder mehr als ein ':' oder leerer String + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + // Is Param1 eventuelle das Volume des aktuellen Pfades ? + USHORT nMatchPoint = aPath.Match(aPar1); + if (nMatchPoint != (nFirstColon + 1)) + { + String aPseudoFile(aPar1); + aPseudoFile += 'X'; // Pseudodatei + + nErr = FSMakeFSSpec(0,0,aPseudoFile.GetPascalStr(),&aFileSpec); + + if(nErr == nsvErr) + { + StarBASIC::Error( SbERR_NO_DEVICE ); + return; + } + aPath = aPar1; + } + } + + rPar.Get(0)->PutString(aPath); + +#elif defined( UNX ) + + int nSize = _PATH_INCR; + char* pMem; + while( TRUE ) + { + pMem = new char[nSize]; + if( !pMem ) + { + StarBASIC::Error( SbERR_NO_MEMORY ); + return; + } + if( getcwd( pMem, nSize-1 ) != NULL ) + { + rPar.Get(0)->PutString( String::CreateFromAscii(pMem) ); + delete pMem; + return; + } + if( errno != ERANGE ) + { + StarBASIC::Error( SbERR_INTERNAL_ERROR ); + delete pMem; + return; + } + delete pMem; + nSize += _PATH_INCR; + }; + +#endif +} + +RTLFUNC(ChDir) // JSM +{ + rPar.Get(0)->PutEmpty(); + if (rPar.Count() == 2) + { + String aPath = rPar.Get(1)->GetString(); + BOOL bError = FALSE; +#ifdef WNT + // #55997 Laut MI hilft es bei File-URLs einen DirEntry zwischenzuschalten + // #40996 Harmoniert bei Verwendung der WIN32-Funktion nicht mit getdir + DirEntry aEntry( aPath ); + ByteString aFullPath( aEntry.GetFull(), gsl_getSystemTextEncoding() ); + if( chdir( aFullPath.GetBuffer()) ) + bError = TRUE; +#else + if (!DirEntry(aPath).SetCWD()) + bError = TRUE; +#endif + if( bError ) + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(ChDrive) // JSM +{ + rPar.Get(0)->PutEmpty(); + if (rPar.Count() == 2) + { + // Keine Laufwerke in Unix +#ifndef UNX + String aPar1 = rPar.Get(1)->GetString(); + +#if defined (WIN) || defined (WNT) || (defined (OS2) && !defined (WTC)) + if (aPar1.Len() > 0) + { + int nCurDrive = (int)aPar1.GetBuffer()[0]; ; + if ( !isalpha( nCurDrive ) ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + else + nCurDrive -= ( 'A' - 1 ); + if (_chdrive(nCurDrive)) + StarBASIC::Error( SbERR_NO_DEVICE ); + } +#elif defined MAC + // Wen kein ':' drin ist dann haengen wir (netterweise) einen an + if (aPar1.Search(':') == STRING_NOTFOUND) + aPar1 += ':'; + if (!aPar1.Len() || + aPar1.Search(':') != (aPar1.Len() - 1)) + // Kein ':' am Ende oder mehr als ein ':' oder leerer String + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + DirEntry aDrive(aPar1); + if (aDrive.SetCWD()) + return; + else + StarBASIC::Error( SbERR_NO_DEVICE ); +#endif + +#endif + // #ifndef UNX + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + + +// Implementation of StepRENAME with UCB +void implStepRenameUCB( const String& aSource, const String& aDest ) +{ + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + xSFI->move( getFullPath( aSource ), getFullPath( aDest ) ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } +} + +RTLFUNC(FileCopy) // JSM +{ + rPar.Get(0)->PutEmpty(); + if (rPar.Count() == 3) + { + String aSource = rPar.Get(1)->GetString(); + String aDest = rPar.Get(2)->GetString(); + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + xSFI->copy( getFullPath( aSource ), getFullPath( aDest ) ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + DirEntry aSourceDirEntry(aSource); + if (aSourceDirEntry.Exists()) + { + if (aSourceDirEntry.CopyTo(DirEntry(aDest),FSYS_ACTION_COPYFILE) != FSYS_ERR_OK) + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } + else + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(Kill) // JSM +{ + rPar.Get(0)->PutEmpty(); + if (rPar.Count() == 2) + { + String aFileSpec = rPar.Get(1)->GetString(); + + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + xSFI->kill( getFullPath( aFileSpec ) ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + if(DirEntry(aFileSpec).Kill() != FSYS_ERR_OK) + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(MkDir) // JSM +{ + rPar.Get(0)->PutEmpty(); + if (rPar.Count() == 2) + { + String aPath = rPar.Get(1)->GetString(); + + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + xSFI->createFolder( getFullPath( aPath ) ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + if (!DirEntry(aPath).MakeDir()) + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(RmDir) // JSM +{ + rPar.Get(0)->PutEmpty(); + if (rPar.Count() == 2) + { + String aPath = rPar.Get(1)->GetString(); + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + xSFI->kill( getFullPath( aPath ) ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + DirEntry aDirEntry(aPath); + if (aDirEntry.Kill() != FSYS_ERR_OK) + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(SendKeys) // JSM +{ + rPar.Get(0)->PutEmpty(); + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); +} + +RTLFUNC(Exp) +{ + ULONG nArgCount = rPar.Count(); + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double aDouble = rPar.Get( 1 )->GetDouble(); + aDouble = exp( aDouble ); + rPar.Get( 0 )->PutDouble( aDouble ); + } +} + +RTLFUNC(FileLen) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + String aStr( pArg->GetString() ); + INT32 nLen = 0; + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + nLen = xSFI->getSize( getFullPath( aStr ) ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + FileStat aStat = DirEntry( aStr ); + nLen = aStat.GetSize(); + } + rPar.Get(0)->PutLong( (long)nLen ); + } +} + + +RTLFUNC(Hex) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + char aBuffer[16]; + SbxVariableRef pArg = rPar.Get( 1 ); + if ( pArg->IsInteger() ) + sprintf( aBuffer,"%X", pArg->GetInteger() ); + else + sprintf( aBuffer,"%lX", pArg->GetLong() ); + rPar.Get(0)->PutString( String::CreateFromAscii( aBuffer ) ); + } +} + +// InStr( [start],string,string,[compare] ) + +RTLFUNC(InStr) +{ + ULONG nArgCount = rPar.Count()-1; + if ( nArgCount < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + USHORT nStartPos = 1; + + USHORT nFirstStringPos = 1; + if ( nArgCount >= 3 ) + { + nStartPos = (USHORT)(rPar.Get(1)->GetInteger()); + if ( nStartPos == 0 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + nStartPos = 1; + } + nFirstStringPos++; + } + int bNotCaseSensitive = 1; // wird noch nicht ausgewertet + if ( nArgCount == 4 ) + bNotCaseSensitive = rPar.Get(4)->GetInteger(); + + USHORT nPos; + + if( !bNotCaseSensitive ) + { + const String& rStr1 = rPar.Get(nFirstStringPos)->GetString(); + const String& rToken = rPar.Get(nFirstStringPos+1)->GetString(); + + nPos = rStr1.Search( rToken, nStartPos-1 ); + if ( nPos == STRING_NOTFOUND ) + nPos = 0; + else + nPos++; + } + else + { + String aStr1 = rPar.Get(nFirstStringPos)->GetString(); + String aToken = rPar.Get(nFirstStringPos+1)->GetString(); + + aStr1.ToUpperAscii(); + aToken.ToUpperAscii(); + + nPos = aStr1.Search( aToken, nStartPos-1 ); + if ( nPos == STRING_NOTFOUND ) + nPos = 0; + else + nPos++; + } + rPar.Get(0)->PutInteger( (int)nPos ); + } +} + + +/* + Int( 2.8 ) = 2.0 + Int( -2.8 ) = -3.0 + Fix( 2.8 ) = 2.0 + Fix( -2.8 ) = -2.0 <- !! +*/ + +RTLFUNC(Int) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + double aDouble= pArg->GetDouble(); + /* + floor( 2.8 ) = 2.0 + floor( -2.8 ) = -3.0 + */ + aDouble = floor( aDouble ); + rPar.Get(0)->PutDouble( aDouble ); + } +} + + + +RTLFUNC(Fix) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + double aDouble = pArg->GetDouble(); + if ( aDouble >= 0.0 ) + aDouble = floor( aDouble ); + else + aDouble = ceil( aDouble ); + rPar.Get(0)->PutDouble( aDouble ); + } +} + + +RTLFUNC(LCase) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + const International& rInt = GetpApp()->GetAppInternational(); + String aStr( rPar.Get(1)->GetString() ); + rInt.ToLower( aStr ); + rPar.Get(0)->PutString( aStr ); + } +} + +RTLFUNC(Left) +{ + ULONG nArgCount = rPar.Count(); + if ( rPar.Count() < 3 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr( rPar.Get(1)->GetString() ); + short nCount = (USHORT)( rPar.Get(2)->GetLong() ); + if ( nCount < 0 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + aStr.Erase( (USHORT)nCount ); + rPar.Get(0)->PutString( aStr ); + } + } +} + +RTLFUNC(Log) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double aArg = rPar.Get(1)->GetDouble(); + if ( aArg > 0 ) + rPar.Get( 0 )->PutDouble( log( aArg )); + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + } +} + +RTLFUNC(LTrim) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr( rPar.Get(1)->GetString() ); + aStr.EraseLeadingChars(); + rPar.Get(0)->PutString( aStr ); + } +} + + +// Mid( String, nStart, nLength ) + +RTLFUNC(Mid) +{ + ULONG nArgCount = rPar.Count()-1; + if ( nArgCount < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + // #23178: Funktionalitaet von Mid$ als Anweisung nachbilden, indem + // als weiterer (4.) Parameter ein Ersetzungsstring aufgenommen wird. + // Anders als im Original kann in dieser Variante der 3. Parameter + // nLength nicht weggelassen werden. Ist ueber bWrite schon vorgesehen. + if( nArgCount == 4 ) + bWrite = TRUE; + + String aArgStr = rPar.Get(1)->GetString(); + USHORT nStartPos = (USHORT)(rPar.Get(2)->GetLong() ); + if ( nStartPos == 0 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + nStartPos--; + USHORT nLen = 0xffff; + if ( nArgCount == 3 || bWrite ) + nLen = (USHORT)(rPar.Get(3)->GetLong() ); + String aResultStr; + if ( bWrite ) + { + aResultStr = aArgStr; + aResultStr.Erase( nStartPos, nLen ); + aResultStr.Insert(rPar.Get(4)->GetString(),0,nLen,nStartPos); + rPar.Get(1)->PutString( aResultStr ); + } + else + { + aResultStr = aArgStr.Copy( nStartPos, nLen ); + rPar.Get(0)->PutString( aResultStr ); + } + } + } +} + +RTLFUNC(Oct) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + char aBuffer[16]; + SbxVariableRef pArg = rPar.Get( 1 ); + if ( pArg->IsInteger() ) + sprintf( aBuffer,"%o", pArg->GetInteger() ); + else + sprintf( aBuffer,"%lo", pArg->GetLong() ); + rPar.Get(0)->PutString( String::CreateFromAscii( aBuffer ) ); + } +} + +RTLFUNC(Right) +{ + ULONG nArgCount = rPar.Count(); + if ( rPar.Count() < 3 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + const String& rStr = rPar.Get(1)->GetString(); + USHORT nResultLen = (USHORT)(rPar.Get(2)->GetLong() ); + USHORT nStrLen = rStr.Len(); + if ( nResultLen > nStrLen ) + nResultLen = nStrLen; + String aResultStr = rStr.Copy( nStrLen-nResultLen ); + rPar.Get(0)->PutString( aResultStr ); + } +} + +RTLFUNC(RTrim) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr( rPar.Get(1)->GetString() ); + aStr.EraseTrailingChars(); + rPar.Get(0)->PutString( aStr ); + } +} + +RTLFUNC(Sgn) +{ + ULONG nArgCount = rPar.Count(); + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double aDouble = rPar.Get(1)->GetDouble(); + INT16 nResult = 0; + if ( aDouble > 0 ) + nResult = 1; + else if ( aDouble < 0 ) + nResult = -1; + rPar.Get(0)->PutInteger( nResult ); + } +} + +RTLFUNC(Space) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr; + aStr.Fill( (USHORT)(rPar.Get(1)->GetLong() )); + rPar.Get(0)->PutString( aStr ); + } +} + +RTLFUNC(Spc) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr; + aStr.Fill( (USHORT)(rPar.Get(1)->GetLong() )); + rPar.Get(0)->PutString( aStr ); + } +} + +RTLFUNC(Sqr) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double aDouble = rPar.Get(1)->GetDouble(); + if ( aDouble >= 0 ) + rPar.Get(0)->PutDouble( sqrt( aDouble )); + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + } +} + +RTLFUNC(Str) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr; + rPar.Get( 1 )->Format( aStr ); + // Numbers start with a space + if( rPar.Get( 1 )->IsNumericRTL() ) + aStr.Insert( ' ', 0 ); + // Kommas durch Punkte ersetzen, damits symmetrisch zu Val ist! + aStr.SearchAndReplace( ',', '.' ); + rPar.Get(0)->PutString( aStr ); + } +} + +RTLFUNC(StrComp) +{ + + if ( rPar.Count() < 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + rPar.Get(0)->PutEmpty(); + return; + } + const String& rStr1 = rPar.Get(1)->GetString(); + const String& rStr2 = rPar.Get(2)->GetString(); + INT16 nNotCaseSensitive = TRUE; + if ( rPar.Count() == 4 ) + nNotCaseSensitive = rPar.Get(3)->GetInteger(); + + const International& aInternational = GetpApp()->GetAppInternational(); + StringCompare aResult; + if ( !nNotCaseSensitive ) + aResult = aInternational.Compare( rStr1, rStr2 ); + else + aResult = rStr1.CompareTo( rStr2 ); + int nRetValue = 0; + if ( aResult == COMPARE_LESS ) + nRetValue = -1; + else if ( aResult == COMPARE_GREATER ) + nRetValue = 1; + rPar.Get(0)->PutInteger( nRetValue ); +} + +RTLFUNC(String) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr; + sal_Unicode aFiller; + USHORT nCount = (USHORT)(rPar.Get(1)->GetLong()); + if( rPar.Get(2)->GetType() == SbxINTEGER ) + aFiller = (char)rPar.Get(2)->GetInteger(); + else + { + const String& rStr = rPar.Get(2)->GetString(); + aFiller = rStr.GetBuffer()[0]; + } + aStr.Fill( nCount, aFiller ); + rPar.Get(0)->PutString( aStr ); + } +} + +RTLFUNC(Tan) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + rPar.Get( 0 )->PutDouble( tan( pArg->GetDouble() ) ); + } +} + +RTLFUNC(UCase) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + const International& rInt = GetpApp()->GetAppInternational(); + String aStr( rPar.Get(1)->GetString() ); + rInt.ToUpper( aStr ); + rPar.Get(0)->PutString( aStr ); + } +} + + +RTLFUNC(Val) +{ + static International aEnglischIntn( LANGUAGE_ENGLISH_US, LANGUAGE_ENGLISH_US ); + + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double nResult; + char* pEndPtr; + + String aStr( rPar.Get(1)->GetString() ); +// lt. Mikkysoft bei Kommas abbrechen! +// for( USHORT n=0; n < aStr.Len(); n++ ) +// if( aStr[n] == ',' ) aStr[n] = '.'; + + FilterWhiteSpace( aStr ); + if ( aStr.GetBuffer()[0] == '&' && aStr.Len() > 1 ) + { + int nRadix = 10; + char aChar = aStr.GetBuffer()[1]; + if ( aChar == 'h' || aChar == 'H' ) + nRadix = 16; + else if ( aChar == 'o' || aChar == 'O' ) + nRadix = 8; + if ( nRadix != 10 ) + { + ByteString aByteStr( aStr, gsl_getSystemTextEncoding() ); + INT16 nlResult = (INT16)strtol( aByteStr.GetBuffer()+2, &pEndPtr, nRadix); + nResult = (double)nlResult; + } + } + else + { + // #57844 Lokalisierte Funktion benutzen + int nErrno; + nResult = SolarMath::StringToDouble( aStr.GetBuffer(), aEnglischIntn, nErrno ); + // ATL: nResult = strtod( aStr.GetStr(), &pEndPtr ); + } + + rPar.Get(0)->PutDouble( nResult ); + } +} + +RTLFUNC(DateSerial) +{ + if ( rPar.Count() < 4 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nYear = rPar.Get(1)->GetInteger(); + INT16 nMonth = rPar.Get(2)->GetInteger(); + INT16 nDay = rPar.Get(3)->GetInteger(); + if ( nYear < 100 ) + nYear += 1900; + if ((nYear < 100 || nYear > 9999) || + (nMonth < 1 || nMonth > 12 ) || + (nDay < 1 || nDay > 31 )) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + Date aCurDate( nDay, nMonth, nYear ); + long nDiffDays = GetDayDiff( aCurDate ); + rPar.Get(0)->PutDate( (double)nDiffDays ); // JSM +} + +RTLFUNC(TimeSerial) +{ + if ( rPar.Count() < 4 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nHour = rPar.Get(1)->GetInteger(); + if ( nHour == 24 ) + nHour = 0; // Wegen UNO DateTimes, die bis 24 Uhr gehen + INT16 nMinute = rPar.Get(2)->GetInteger(); + INT16 nSecond = rPar.Get(3)->GetInteger(); + if ((nHour < 0 || nHour > 23) || + (nMinute < 0 || nMinute > 59 ) || + (nSecond < 0 || nSecond > 59 )) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + INT32 nSeconds = nHour; + nSeconds *= 3600; + nSeconds += nMinute * 60; + nSeconds += nSecond; + double nDays = ((double)nSeconds) / (double)(86400.0); + rPar.Get(0)->PutDate( nDays ); // JSM +} + +RTLFUNC(DateValue) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden + SvNumberFormatter* pFormatter = NULL; + if( pINST ) + pFormatter = pINST->GetNumberFormatter(); + else + { + ULONG n; // Dummy + SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n ); + } + + ULONG nIndex; + double fResult; + String aStr( rPar.Get(1)->GetString() ); + BOOL bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, fResult ); + short nType = pFormatter->GetType( nIndex ); + if(bSuccess && (nType==NUMBERFORMAT_DATE || nType==NUMBERFORMAT_DATETIME)) + { + if ( nType == NUMBERFORMAT_DATETIME ) + { + // Zeit abschneiden + if ( fResult > 0.0 ) + fResult = floor( fResult ); + else + fResult = ceil( fResult ); + } + // fResult += 2.0; // Anpassung StarCalcFormatter + rPar.Get(0)->PutDate( fResult ); // JSM + } + else + StarBASIC::Error( SbERR_CONVERSION ); + + // #39629 pFormatter kann selbst angefordert sein + if( !pINST ) + delete pFormatter; + } +} + +RTLFUNC(TimeValue) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden + SvNumberFormatter* pFormatter = NULL; + if( pINST ) + pFormatter = pINST->GetNumberFormatter(); + else + { + ULONG n; // Dummy + SbiInstance::PrepareNumberFormatter( pFormatter, n, n, n ); + } + + ULONG nIndex; + double fResult; + BOOL bSuccess = pFormatter->IsNumberFormat( rPar.Get(1)->GetString(), + nIndex, fResult ); + short nType = pFormatter->GetType(nIndex); + if(bSuccess && (nType==NUMBERFORMAT_TIME||nType==NUMBERFORMAT_DATETIME)) + { + if ( nType == NUMBERFORMAT_DATETIME ) + // Tage abschneiden + fResult = fmod( fResult, 1 ); + rPar.Get(0)->PutDate( fResult ); // JSM + } + else + StarBASIC::Error( SbERR_CONVERSION ); + + // #39629 pFormatter kann selbst angefordert sein + if( !pINST ) + delete pFormatter; + } +} + +RTLFUNC(Day) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxVariableRef pArg = rPar.Get( 1 ); + double aDouble = pArg->GetDate(); + aDouble -= 2.0; // normieren: 1.1.1900 => 0.0 + Date aRefDate( 1, 1, 1900 ); + // aDouble = Fix( aDouble ); + if ( aDouble >= 0.0 ) + { + aDouble = floor( aDouble ); + aRefDate += (ULONG)aDouble; + } + else + { + aDouble = ceil( aDouble ); + aRefDate -= (ULONG)(-1.0 * aDouble); + } + rPar.Get(0)->PutInteger( (INT16)(aRefDate.GetDay())); + } +} + +RTLFUNC(Weekday) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + Date aRefDate( 1,1,1900 ); + long nDays = (long) rPar.Get(1)->GetDate(); + nDays -= 2; // normieren: 1.1.1900 => 0 + aRefDate += nDays; + DayOfWeek aDay = aRefDate.GetDayOfWeek(); + INT16 nDay; + if ( aDay != SUNDAY ) + nDay = (INT16)aDay + 2; + else + nDay = 1; // 1==Sonntag + rPar.Get(0)->PutInteger( nDay ); + } +} + +RTLFUNC(Year) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + Date aRefDate( 1,1,1900 ); + long nDays = (long) rPar.Get(1)->GetDate(); + nDays -= 2; // normieren: 1.1.1900 => 0.0 + aRefDate += nDays; + rPar.Get(0)->PutInteger( (INT16)(aRefDate.GetYear()) ); + } +} + +RTLFUNC(Hour) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double nArg = rPar.Get(1)->GetDate(); + if ( nArg < 0.0 ) + nArg *= -1.0; + double nFrac = nArg - floor( nArg ); + nFrac *= 86400.0; + INT32 nSeconds = (INT32)nFrac; + INT16 nHour = (INT16)(nSeconds / 3600); + rPar.Get(0)->PutInteger( nHour ); + } +} + + +RTLFUNC(Minute) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double nArg = rPar.Get(1)->GetDate(); + if ( nArg < 0.0 ) + nArg *= -1.0; + double nFrac = nArg - floor( nArg ); + nFrac *= 86400.0; + INT32 nSeconds = (INT32)nFrac; + INT16 nTemp = (INT16)(nSeconds % 3600); + INT16 nMin = nTemp / 60; + rPar.Get(0)->PutInteger( nMin ); + } +} + +RTLFUNC(Month) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + Date aRefDate( 1,1,1900 ); + long nDays = (long) rPar.Get(1)->GetDate(); + nDays -= 2; // normieren: 1.1.1900 => 0.0 + aRefDate += nDays; + rPar.Get(0)->PutInteger( (INT16)(aRefDate.GetMonth()) ); + } +} + +RTLFUNC(Second) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double nArg = rPar.Get(1)->GetDate(); + if ( nArg < 0.0 ) + nArg *= -1.0; + double nFrac = nArg - floor( nArg ); + nFrac *= 86400.0; + INT32 nSeconds = (INT32)nFrac; + INT16 nTemp = (INT16)(nSeconds / 3600); + nSeconds -= nTemp * 3600; + nTemp = (INT16)(nSeconds / 60); + nSeconds -= nTemp * 60; + rPar.Get(0)->PutInteger( (INT16)nSeconds ); + } +} + +// Date Now(void) + +RTLFUNC(Now) +{ + Date aDate; + Time aTime; + double aSerial = (double)GetDayDiff( aDate ); + long nSeconds = aTime.GetHour(); + nSeconds *= 3600; + nSeconds += aTime.GetMin() * 60; + nSeconds += aTime.GetSec(); + double nDays = ((double)nSeconds) / (double)(24.0*3600.0); + aSerial += nDays; + rPar.Get(0)->PutDate( aSerial ); +} + +// Date Time(void) + +RTLFUNC(Time) +{ + if ( !bWrite ) + { + Time aTime; + SbxVariable* pMeth = rPar.Get( 0 ); + String aRes; + if( pMeth->IsFixed() ) + { + // Time$: hh:mm:ss + char buf[ 20 ]; + sprintf( buf, "%02d:%02d:%02d", + aTime.GetHour(), aTime.GetMin(), aTime.GetSec() ); + aRes = String::CreateFromAscii( buf ); + } + else + { + // Time: system dependent + long nSeconds=aTime.GetHour(); + nSeconds *= 3600; + nSeconds += aTime.GetMin() * 60; + nSeconds += aTime.GetSec(); + double nDays = (double)nSeconds * ( 1.0 / (24.0*3600.0) ); + Color* pCol; + + // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden + SvNumberFormatter* pFormatter = NULL; + ULONG nIndex; + if( pINST ) + { + pFormatter = pINST->GetNumberFormatter(); + nIndex = pINST->GetStdTimeIdx(); + } + else + { + ULONG n; // Dummy + SbiInstance::PrepareNumberFormatter( pFormatter, n, nIndex, n ); + } + + pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol ); + + // #39629 pFormatter kann selbst angefordert sein + if( !pINST ) + delete pFormatter; + } + pMeth->PutString( aRes ); + } + else + { + StarBASIC::Error( SbERR_NOT_IMPLEMENTED ); + } +} + +RTLFUNC(Timer) +{ + Time aTime; + long nSeconds = aTime.GetHour(); + nSeconds *= 3600; + nSeconds += aTime.GetMin() * 60; + nSeconds += aTime.GetSec(); + rPar.Get(0)->PutDate( (double)nSeconds ); +} + + +RTLFUNC(Date) +{ + if ( !bWrite ) + { + Date aToday; + double nDays = (double)GetDayDiff( aToday ); + SbxVariable* pMeth = rPar.Get( 0 ); + if( pMeth->IsString() ) + { + String aRes; + Color* pCol; + + // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden + SvNumberFormatter* pFormatter = NULL; + ULONG nIndex; + if( pINST ) + { + pFormatter = pINST->GetNumberFormatter(); + nIndex = pINST->GetStdDateIdx(); + } + else + { + ULONG n; // Dummy + SbiInstance::PrepareNumberFormatter( pFormatter, nIndex, n, n ); + } + + pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol ); + pMeth->PutString( aRes ); + + // #39629 pFormatter kann selbst angefordert sein + if( !pINST ) + delete pFormatter; + } + else + pMeth->PutDate( nDays ); + } + else + { + StarBASIC::Error( SbERR_NOT_IMPLEMENTED ); + } +} + +RTLFUNC(IsArray) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + rPar.Get(0)->PutBool((rPar.Get(1)->GetType() & SbxARRAY) ? TRUE : FALSE ); +} + +RTLFUNC(IsObject) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + rPar.Get( 0 )->PutBool( rPar.Get(1)->IsObject() ); +} + +RTLFUNC(IsDate) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + // #46134 Nur String wird konvertiert, andere Typen ergeben FALSE + SbxVariableRef xArg = rPar.Get( 1 ); + SbxDataType eType = xArg->GetType(); + BOOL bDate = FALSE; + + if( eType == SbxDATE ) + { + bDate = TRUE; + } + else if( eType == SbxSTRING ) + { + // Error loeschen + SbxError nPrevError = SbxBase::GetError(); + SbxBase::ResetError(); + + // Konvertierung des Parameters nach SbxDATE erzwingen + xArg->SbxValue::GetDate(); + + // Bei Fehler ist es kein Date + bDate = !SbxBase::IsError(); + + // Error-Situation wiederherstellen + SbxBase::ResetError(); + SbxBase::SetError( nPrevError ); + } + rPar.Get( 0 )->PutBool( bDate ); + } +} + +RTLFUNC(IsEmpty) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + rPar.Get( 0 )->PutBool( rPar.Get(1)->IsEmpty() ); +} + +RTLFUNC(IsError) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + rPar.Get( 0 )->PutBool( rPar.Get(1)->IsErr() ); +} + +RTLFUNC(IsNull) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + // #51475 Wegen Uno-Objekten auch true liefern, + // wenn der pObj-Wert NULL ist + SbxVariableRef pArg = rPar.Get( 1 ); + BOOL bNull = rPar.Get(1)->IsNull(); + if( !bNull && pArg->GetType() == SbxOBJECT ) + { + SbxBase* pObj = pArg->GetObject(); + if( !pObj ) + bNull = TRUE; + } + rPar.Get( 0 )->PutBool( bNull ); + } +} + +RTLFUNC(IsNumeric) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + rPar.Get( 0 )->PutBool( rPar.Get( 1 )->IsNumericRTL() ); +} + +// Das machen wir auf die billige Tour + +RTLFUNC(IsMissing) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + // #57915 Missing wird durch Error angezeigt + rPar.Get( 0 )->PutBool( rPar.Get(1)->IsErr() ); +} + +// Dir( [Maske] [,Attrs] ) +// ToDo: Library-globaler Datenbereich fuer Dir-Objekt und Flags + +static String getFileNameFromURL( const String& aURL ); + +RTLFUNC(Dir) +{ + String aPath; + + USHORT nParCount = rPar.Count(); + if( nParCount > 3 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbiRTLData* pRTLData = pINST->GetRTLData(); + + // #34645: Kann auch von der URL-Zeile ueber 'macro: Dir' aufgerufen werden + // dann existiert kein pRTLData und die Methode muss verlassen werden + if( !pRTLData ) + return; + + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + if ( nParCount >= 2 ) + { + String aStr = getFullPath( rPar.Get(1)->GetString() ); + OUString aUNCPath; + FileBase::normalizePath( aStr, aUNCPath ); + OUString aFileURLStr; + FileBase::getFileURLFromNormalizedPath( aUNCPath, aFileURLStr ); + + try + { + String aDirURLStr; + sal_Bool bFolder = sal_False; + try { bFolder = xSFI->isFolder( aFileURLStr ); } + catch( Exception & ) {} + //catch( ::ucb::ContentCreationException & e ) + //{ + //::ucb::ContentCreationException::Reason aReason = e.getReason(); + //} + + if( bFolder ) + { + aDirURLStr = aFileURLStr; + } + else + { + INetURLObject aFileURL( aFileURLStr ); + + // Not folder but exists? Return file! + sal_Bool bExists = sal_False; + try { bExists = xSFI->exists( aFileURLStr ); } + //catch( ::ucb::ContentCreationException & e ) + //{ + //::ucb::ContentCreationException::Reason aReason = e.getReason(); + //} + catch( Exception & ) {} + if( bExists ) + { + String aNameOnlyStr = aFileURL.getName( INetURLObject::LAST_SEGMENT, + true, INetURLObject::DECODE_WITH_CHARSET ); + rPar.Get(0)->PutString( aNameOnlyStr ); + return; + } + aDirURLStr = aFileURL.GetPath(); + } + + USHORT nFlags = 0; + if ( nParCount > 2 ) + pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger(); + else + pRTLData->nDirFlags = 0; + + // Read directory + sal_Bool bIncludeFolders = ((nFlags & Sb_ATTR_DIRECTORY) != 0); + pRTLData->aDirSeq = xSFI->getFolderContents( aDirURLStr, bIncludeFolders ); + pRTLData->nCurDirPos = 0; + } + catch( Exception & ) + { + //StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + + + if( pRTLData->aDirSeq.getLength() > 0 ) + { + sal_Bool bOnlyFolders = ((pRTLData->nDirFlags & Sb_ATTR_DIRECTORY) != 0); + for( ;; ) + { + if( pRTLData->nCurDirPos >= pRTLData->aDirSeq.getLength() ) + { + pRTLData->aDirSeq.realloc( 0 ); + aPath.Erase(); + break; + } + else + { + OUString aFile = pRTLData->aDirSeq.getConstArray()[pRTLData->nCurDirPos++]; + + // Only directories? + if( bOnlyFolders ) + { + sal_Bool bFolder = sal_False; + try { bFolder = xSFI->isFolder( aFile ); } + catch( Exception & ) {} + if( !bFolder ) + continue; + } + + INetURLObject aURL( aFile ); + aPath = aURL.getName( INetURLObject::LAST_SEGMENT, true, + INetURLObject::DECODE_WITH_CHARSET ); + break; + } + } + } + rPar.Get(0)->PutString( aPath ); + } + } + else + // --> UCB + { + if ( nParCount >= 2 ) + { + delete pRTLData->pDir; + pRTLData->pDir = 0; // wg. Sonderbehandlung Sb_ATTR_VOLUME + DirEntry aEntry( rPar.Get(1)->GetString() ); + FileStat aStat( aEntry ); + if(!aStat.GetError() && (aStat.GetKind() & FSYS_KIND_FILE)) + { + // ah ja, ist nur ein dateiname + // Pfad abschneiden (wg. VB4) + rPar.Get(0)->PutString( aEntry.GetName() ); + return; + } + USHORT nFlags = 0; + if ( nParCount > 2 ) + pRTLData->nDirFlags = nFlags = rPar.Get(2)->GetInteger(); + else + pRTLData->nDirFlags = 0; + // Nur diese Bitmaske ist unter Windows erlaubt + #ifdef WIN + if( nFlags & ~0x1E ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ), pRTLData->nDirFlags = 0; + #endif + // Sb_ATTR_VOLUME wird getrennt gehandelt + if( pRTLData->nDirFlags & Sb_ATTR_VOLUME ) + aPath = aEntry.GetVolume(); + else + { + // Die richtige Auswahl treffen + USHORT nMode = FSYS_KIND_FILE; + if( nFlags & Sb_ATTR_DIRECTORY ) + nMode |= FSYS_KIND_DIR; + if( nFlags == Sb_ATTR_DIRECTORY ) + nMode = FSYS_KIND_DIR; + pRTLData->pDir = new Dir( aEntry, (DirEntryKind) nMode ); + pRTLData->nCurDirPos = 0; + } + } + + if( pRTLData->pDir ) + { + for( ;; ) + { + if( pRTLData->nCurDirPos >= pRTLData->pDir->Count() ) + { + delete pRTLData->pDir; + pRTLData->pDir = 0; + aPath.Erase(); + break; + } + DirEntry aNextEntry=(*(pRTLData->pDir))[pRTLData->nCurDirPos++]; + aPath = aNextEntry.GetName(); //Full(); + #ifdef WIN + aNextEntry.ToAbs(); + String sFull(aNextEntry.GetFull()); + unsigned nFlags; + + if (_dos_getfileattr( sFull.GetStr(), &nFlags )) + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + else + { + INT16 nCurFlags = pRTLData->nDirFlags; + if( (nCurFlags == Sb_ATTR_NORMAL) + && !(nFlags & ( _A_HIDDEN | _A_SYSTEM | _A_VOLID | _A_SUBDIR ) ) ) + break; + else if( (nCurFlags & Sb_ATTR_HIDDEN) && (nFlags & _A_HIDDEN) ) + break; + else if( (nCurFlags & Sb_ATTR_SYSTEM) && (nFlags & _A_SYSTEM) ) + break; + else if( (nCurFlags & Sb_ATTR_VOLUME) && (nFlags & _A_VOLID) ) + break; + else if( (nCurFlags & Sb_ATTR_DIRECTORY) && (nFlags & _A_SUBDIR) ) + break; + } + #else + break; + #endif + } + } + rPar.Get(0)->PutString( aPath ); + } + } +} + + +RTLFUNC(GetAttr) +{ + if ( rPar.Count() == 2 ) + { + INT16 nFlags = 0; + + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + String aPath = getFullPath( rPar.Get(1)->GetString() ); + sal_Bool bExists = sal_False; + try { bExists = xSFI->exists( aPath ); } + catch( Exception & ) {} + if( !bExists ) + { + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + return; + } + + sal_Bool bReadOnly = xSFI->isReadOnly( aPath ); + sal_Bool bDirectory = xSFI->isFolder( aPath ); + if( bReadOnly ) + nFlags |= 0x0001; // ATTR_READONLY + if( bDirectory ) + nFlags |= 0x0010; // ATTR_DIRECTORY + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + DirEntry aEntry( rPar.Get(1)->GetString() ); + aEntry.ToAbs(); + BOOL bUseFileStat = FALSE; + + // #57064 Bei virtuellen URLs den Real-Path extrahieren + String aFile = aEntry.GetFull(); + ByteString aByteStrFullPath( aEntry.GetFull(), gsl_getSystemTextEncoding() ); + #if defined( WIN ) + int nErr = _dos_getfileattr( aByteStrFullPath.GetBuffer(),(unsigned *) &nFlags ); + if ( nErr ) + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + #elif defined( WNT ) + DWORD nRealFlags = GetFileAttributes (aByteStrFullPath.GetBuffer()); + if (nRealFlags != 0xffffffff) + { + if (nRealFlags == FILE_ATTRIBUTE_NORMAL) + nRealFlags = 0; + nFlags = (INT16) (nRealFlags); + } + else + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + #elif defined( OS2 ) + FILESTATUS3 aFileStatus; + APIRET rc = DosQueryPathInfo(aByteStrFullPath.GetBuffer(),1, + &aFileStatus,sizeof(FILESTATUS3)); + if (!rc) + nFlags = (INT16) aFileStatus.attrFile; + else + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + #else + bUseFileStat = TRUE; + #endif + if( bUseFileStat ) + { + if( FileStat::GetReadOnlyFlag( aEntry ) ) + nFlags |= 0x0001; // ATTR_READONLY + FileStat aStat( aEntry ); + DirEntryKind eKind = aStat.GetKind(); + if( eKind & FSYS_KIND_DIR ) + nFlags |= 0x0010; // ATTR_DIRECTORY + if( aEntry.GetFlag() & FSYS_FLAG_VOLUME ) + nFlags |= 0x0008; // ATTR_VOLUME + } + } + rPar.Get(0)->PutInteger( nFlags ); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + + +RTLFUNC(FileDateTime) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + + // <-- UCB + String aPath = rPar.Get(1)->GetString(); + Time aTime; + Date aDate; + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + com::sun::star::util::DateTime aUnoDT = xSFI->getDateTimeModified( aPath ); + aTime = Time( aUnoDT.Hours, aUnoDT.Minutes, aUnoDT.Seconds, aUnoDT.HundredthSeconds ); + aDate = Date( aUnoDT.Day, aUnoDT.Month, aUnoDT.Year ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + DirEntry aEntry( aPath ); + FileStat aStat( aEntry ); + aTime = Time( aStat.TimeModified() ); + aDate = Date( aStat.DateModified() ); + } + + double fSerial = (double)GetDayDiff( aDate ); + long nSeconds = aTime.GetHour(); + nSeconds *= 3600; + nSeconds += aTime.GetMin() * 60; + nSeconds += aTime.GetSec(); + double nDays = ((double)nSeconds) / (double)(24.0*3600.0); + fSerial += nDays; + + Color* pCol; + + // #39629 pINST pruefen, kann aus URL-Zeile gerufen werden + SvNumberFormatter* pFormatter = NULL; + ULONG nIndex; + if( pINST ) + { + pFormatter = pINST->GetNumberFormatter(); + nIndex = pINST->GetStdDateTimeIdx(); + } + else + { + ULONG n; // Dummy + SbiInstance::PrepareNumberFormatter( pFormatter, n, n, nIndex ); + } + + String aRes; + pFormatter->GetOutputString( fSerial, nIndex, aRes, &pCol ); + rPar.Get(0)->PutString( aRes ); + + // #39629 pFormatter kann selbst angefordert sein + if( !pINST ) + delete pFormatter; + } +} + + +RTLFUNC(EOF) +{ + // AB 08/16/2000: No changes for UCB + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + INT16 nChannel = rPar.Get(1)->GetInteger(); + // nChannel--; // macht MD beim Oeffnen auch nicht + SbiIoSystem* pIO = pINST->GetIoSystem(); + SbiStream* pSbStrm = pIO->GetStream( nChannel ); + if ( !pSbStrm ) + { + StarBASIC::Error( SbERR_BAD_CHANNEL ); + return; + } + BOOL bIsEof; + SvStream* pSvStrm = pSbStrm->GetStrm(); + if ( pSbStrm->IsText() ) + { + char cBla; + (*pSvStrm) >> cBla; // koennen wir noch ein Zeichen lesen + bIsEof = pSvStrm->IsEof(); + if ( !bIsEof ) + pSvStrm->SeekRel( -1 ); + } + else + bIsEof = pSvStrm->IsEof(); // fuer binaerdateien! + rPar.Get(0)->PutBool( bIsEof ); + } +} + +RTLFUNC(FileAttr) +{ + // AB 08/16/2000: No changes for UCB + + // #57064 Obwohl diese Funktion nicht mit DirEntry arbeitet, ist sie von + // der Anpassung an virtuelle URLs nich betroffen, da sie nur auf bereits + // geoeffneten Dateien arbeitet und der Name hier keine Rolle spielt. + + if ( rPar.Count() != 3 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + INT16 nChannel = rPar.Get(1)->GetInteger(); +// nChannel--; + SbiIoSystem* pIO = pINST->GetIoSystem(); + SbiStream* pSbStrm = pIO->GetStream( nChannel ); + if ( !pSbStrm ) + { + StarBASIC::Error( SbERR_BAD_CHANNEL ); + return; + } + INT16 nRet; + if ( rPar.Get(2)->GetInteger() == 1 ) + nRet = (INT16)(pSbStrm->GetMode()); + else + nRet = 0; // System file handle not supported + + rPar.Get(0)->PutInteger( nRet ); + } +} +RTLFUNC(Loc) +{ + // AB 08/16/2000: No changes for UCB + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + INT16 nChannel = rPar.Get(1)->GetInteger(); + SbiIoSystem* pIO = pINST->GetIoSystem(); + SbiStream* pSbStrm = pIO->GetStream( nChannel ); + if ( !pSbStrm ) + { + StarBASIC::Error( SbERR_BAD_CHANNEL ); + return; + } + SvStream* pSvStrm = pSbStrm->GetStrm(); + ULONG nPos; + if( pSbStrm->IsRandom()) + { + short nBlockLen = pSbStrm->GetBlockLen(); + nPos = nBlockLen ? (pSvStrm->Tell() / nBlockLen) : 0; + nPos++; // Blockpositionen beginnen bei 1 + } + else if ( pSbStrm->IsText() ) + nPos = pSbStrm->GetLine(); + else if( pSbStrm->IsBinary() ) + nPos = pSvStrm->Tell(); + else if ( pSbStrm->IsSeq() ) + nPos = ( pSvStrm->Tell()+1 ) / 128; + else + nPos = pSvStrm->Tell(); + rPar.Get(0)->PutLong( (INT32)nPos ); + } +} + +RTLFUNC(Lof) +{ + // AB 08/16/2000: No changes for UCB + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + INT16 nChannel = rPar.Get(1)->GetInteger(); + SbiIoSystem* pIO = pINST->GetIoSystem(); + SbiStream* pSbStrm = pIO->GetStream( nChannel ); + if ( !pSbStrm ) + { + StarBASIC::Error( SbERR_BAD_CHANNEL ); + return; + } + SvStream* pSvStrm = pSbStrm->GetStrm(); + ULONG nOldPos = pSvStrm->Tell(); + ULONG nLen = pSvStrm->Seek( STREAM_SEEK_TO_END ); + pSvStrm->Seek( nOldPos ); + rPar.Get(0)->PutLong( (INT32)nLen ); + } +} + + +RTLFUNC(Seek) +{ + // AB 08/16/2000: No changes for UCB + int nArgs = (int)rPar.Count(); + if ( nArgs < 2 || nArgs > 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nChannel = rPar.Get(1)->GetInteger(); +// nChannel--; + SbiIoSystem* pIO = pINST->GetIoSystem(); + SbiStream* pSbStrm = pIO->GetStream( nChannel ); + if ( !pSbStrm ) + { + StarBASIC::Error( SbERR_BAD_CHANNEL ); + return; + } + SvStream* pStrm = pSbStrm->GetStrm(); + + if ( nArgs == 2 ) // Seek-Function + { + ULONG nPos = pStrm->Tell(); + if( pSbStrm->IsRandom() ) + nPos = nPos / pSbStrm->GetBlockLen(); + nPos++; // Basic zaehlt ab 1 + rPar.Get(0)->PutLong( (INT32)nPos ); + } + else // Seek-Statement + { + INT32 nPos = rPar.Get(2)->GetLong(); + if ( nPos < 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + nPos--; // Basic zaehlt ab 1, SvStreams zaehlen ab 0 + pSbStrm->SetExpandOnWriteTo( 0 ); + if ( pSbStrm->IsRandom() ) + nPos *= pSbStrm->GetBlockLen(); + pStrm->Seek( (ULONG)nPos ); + pSbStrm->SetExpandOnWriteTo( nPos ); + } +} + +RTLFUNC(Format) +{ + USHORT nArgCount = (USHORT)rPar.Count(); + if ( nArgCount < 2 || nArgCount > 3 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aResult; + if( nArgCount == 2 ) + rPar.Get(1)->Format( aResult ); + else + { + String aFmt( rPar.Get(2)->GetString() ); + rPar.Get(1)->Format( aResult, &aFmt ); + } + rPar.Get(0)->PutString( aResult ); + } +} + +RTLFUNC(Randomize) +{ + if ( rPar.Count() > 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + INT16 nSeed; + if( rPar.Count() == 2 ) + nSeed = (INT16)rPar.Get(1)->GetInteger(); + else + nSeed = (INT16)rand(); + srand( nSeed ); +} + +RTLFUNC(Rnd) +{ + if ( rPar.Count() > 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + double nRand = (double)rand(); + nRand = ( nRand / (double)RAND_MAX ); + rPar.Get(0)->PutDouble( nRand ); + } +} + + +// +// Syntax: Shell("Path",[ Window-Style,[ "Params", [ bSync = FALSE ]]]) +// +// WindowStyles (VBA-kompatibel): +// 2 == Minimized +// 3 == Maximized +// 10 == Full-Screen (Textmodus-Anwendungen OS/2, WIN95, WNT) +// +// !!!HACK der WindowStyle wird im Creator an Application::StartApp +// uebergeben. Format: "xxxx2" +// + + +RTLFUNC(Shell) +{ + // No shell command for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + if ( rPar.Count() < 2 || rPar.Count() > 5 ) + { + rPar.Get(0)->PutLong(0); + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + } + else + { + USHORT nOptions = NAMESPACE_VOS(OProcess)::TOption_SearchPath| + NAMESPACE_VOS(OProcess)::TOption_Detached; + String aCmdLine = rPar.Get(1)->GetString(); + // Zusaetzliche Parameter anhaengen, es muss eh alles geparsed werden + if( rPar.Count() >= 4 ) + { + aCmdLine.AppendAscii( " " ); + aCmdLine += rPar.Get(3)->GetString(); + } + else if( !aCmdLine.Len() ) + { + // Spezial-Behandlung (leere Liste) vermeiden + aCmdLine.AppendAscii( " " ); + } + USHORT nLen = aCmdLine.Len(); + + // #55735 Wenn Parameter dabei sind, muessen die abgetrennt werden + // #72471 Auch die einzelnen Parameter trennen + std::list<String> aTokenList; + String aToken; + USHORT i = 0; + char c; + while( i < nLen ) + { + // Spaces weg + while( ( c = aCmdLine.GetBuffer()[ i ] ) == ' ' || c == '\t' ) + i++; + + if( c == '\"' || c == '\'' ) + { + USHORT iFoundPos = aCmdLine.Search( c, i + 1 ); + + // Wenn nichts gefunden wurde, Rest kopieren + if( iFoundPos == STRING_NOTFOUND ) + { + aToken = aCmdLine.Copy( i, STRING_LEN ); + i = nLen; + } + else + { + aToken = aCmdLine.Copy( i + 1, (iFoundPos - i - 1) ); + i = iFoundPos + 1; + } + } + else + { + USHORT iFoundSpacePos = aCmdLine.Search( ' ', i ); + USHORT iFoundTabPos = aCmdLine.Search( '\t', i ); + USHORT iFoundPos = Min( iFoundSpacePos, iFoundTabPos ); + + // Wenn nichts gefunden wurde, Rest kopieren + if( iFoundPos == STRING_NOTFOUND ) + { + aToken = aCmdLine.Copy( i, STRING_LEN ); + i = nLen; + } + else + { + aToken = aCmdLine.Copy( i, (iFoundPos - i) ); + i = iFoundPos; + } + } + + // In die Liste uebernehmen + aTokenList.push_back( aToken ); + } + // #55735 / #72471 Ende + + INT16 nWinStyle = 0; + if( rPar.Count() >= 3 ) + { + nWinStyle = rPar.Get(2)->GetInteger(); + switch( nWinStyle ) + { + case 2: + nOptions |= NAMESPACE_VOS(OProcess)::TOption_Minimized; + break; + case 3: + nOptions |= NAMESPACE_VOS(OProcess)::TOption_Maximized; + break; + case 10: + nOptions |= NAMESPACE_VOS(OProcess)::TOption_FullScreen; + break; + } + } + NAMESPACE_VOS(OProcess)::TProcessOption eOptions = + (NAMESPACE_VOS(OProcess)::TProcessOption)nOptions; + + + // #72471 Parameter aufbereiten + std::list<String>::const_iterator iter = aTokenList.begin(); + const String& rStr = *iter; + NAMESPACE_RTL(OUString) aOUStrProg( rStr.GetBuffer(), rStr.Len() ); + iter++; + + USHORT nParamCount = aTokenList.size() - 1; + NAMESPACE_RTL(OUString)* pArgumentList = NULL; + //const char** pParamList = NULL; + if( nParamCount ) + { + pArgumentList = new NAMESPACE_RTL(OUString)[ nParamCount ]; + //pParamList = new const char*[ nParamCount ]; + USHORT iList = 0; + while( iter != aTokenList.end() ) + { + const String& rParamStr = (*iter); + pArgumentList[iList++] = NAMESPACE_RTL(OUString)( rParamStr.GetBuffer(), rParamStr.Len() ); + //pParamList[iList++] = (*iter).GetStr(); + iter++; + } + } + + //const char* pParams = aParams.Len() ? aParams.GetStr() : 0; + NAMESPACE_VOS(OProcess)* pApp; + pApp = new NAMESPACE_VOS(OProcess)( aOUStrProg ); + BOOL bSucc; + if( nParamCount == 0 ) + { + bSucc = pApp->execute( eOptions ) == NAMESPACE_VOS(OProcess)::E_None; + } + else + { + NAMESPACE_VOS(OArgumentList) aArgList( pArgumentList, nParamCount ); + bSucc = pApp->execute( eOptions, aArgList ) == NAMESPACE_VOS(OProcess)::E_None; + } + + /* + if( nParamCount == 0 ) + pApp = new NAMESPACE_VOS(OProcess)( pProg ); + else + pApp = new NAMESPACE_VOS(OProcess)( pProg, pParamList, nParamCount ); + BOOL bSucc = pApp->execute( eOptions ) == NAMESPACE_VOS(OProcess)::E_None; + */ + + delete pApp; + delete[] pArgumentList; + if( !bSucc ) + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + else + rPar.Get(0)->PutLong( 0 ); + } +} + +RTLFUNC(VarType) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxDataType eType = rPar.Get(1)->GetType(); + rPar.Get(0)->PutInteger( (INT16)eType ); + } +} + +RTLFUNC(TypeName) +{ + static const char* pTypeNames[] = + { + "Empty", + "Null", + "Integer", + "Long", + "Single", + "Double", + "Currency", + "Date", + "String", + "Object", + "Error", + "Boolean", + "Variant", + "DataObject", + "Unknown Type", + "Unknown Type", + "Char", + "Byte", + "UShort", + "ULong", + "Long64", + "ULong64", + "Int", + "UInt", + "Void", + "HResult", + "Pointer", + "DimArray", + "CArray", + "Userdef", + "Lpstr", + "Lpwstr", + "Unknown Type", + }; + + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxDataType eType = rPar.Get(1)->GetType(); + BOOL bIsArray = ( ( eType & SbxARRAY ) != 0 ); + int nPos = ((int)eType) & 0x0FFF; + USHORT nTypeNameCount = sizeof( pTypeNames ) / sizeof( char* ); + if ( nPos < 0 || nPos >= nTypeNameCount ) + nPos = nTypeNameCount - 1; + String aRetStr = String::CreateFromAscii( pTypeNames[nPos] ); + if( bIsArray ) + aRetStr.AppendAscii( "()" ); + rPar.Get(0)->PutString( aRetStr ); + } +} + +RTLFUNC(Len) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + const String& rStr = rPar.Get(1)->GetString(); + rPar.Get(0)->PutLong( (INT32)rStr.Len() ); + } +} + +RTLFUNC(DDEInitiate) +{ + // No DDE for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + int nArgs = (int)rPar.Count(); + if ( nArgs != 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + const String& rApp = rPar.Get(1)->GetString(); + const String& rTopic = rPar.Get(2)->GetString(); + + SbiDdeControl* pDDE = pINST->GetDdeControl(); + INT16 nChannel; + SbError nDdeErr = pDDE->Initiate( rApp, rTopic, nChannel ); + if( nDdeErr ) + StarBASIC::Error( nDdeErr ); + else + rPar.Get(0)->PutInteger( nChannel ); +} + +RTLFUNC(DDETerminate) +{ + // No DDE for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + rPar.Get(0)->PutEmpty(); + int nArgs = (int)rPar.Count(); + if ( nArgs != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nChannel = rPar.Get(1)->GetInteger(); + SbiDdeControl* pDDE = pINST->GetDdeControl(); + SbError nDdeErr = pDDE->Terminate( nChannel ); + if( nDdeErr ) + StarBASIC::Error( nDdeErr ); +} + +RTLFUNC(DDETerminateAll) +{ + // No DDE for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + rPar.Get(0)->PutEmpty(); + int nArgs = (int)rPar.Count(); + if ( nArgs != 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + SbiDdeControl* pDDE = pINST->GetDdeControl(); + SbError nDdeErr = pDDE->TerminateAll(); + if( nDdeErr ) + StarBASIC::Error( nDdeErr ); + +} + +RTLFUNC(DDERequest) +{ + // No DDE for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + int nArgs = (int)rPar.Count(); + if ( nArgs != 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nChannel = rPar.Get(1)->GetInteger(); + const String& rItem = rPar.Get(2)->GetString(); + SbiDdeControl* pDDE = pINST->GetDdeControl(); + String aResult; + SbError nDdeErr = pDDE->Request( nChannel, rItem, aResult ); + if( nDdeErr ) + StarBASIC::Error( nDdeErr ); + else + rPar.Get(0)->PutString( aResult ); +} + +RTLFUNC(DDEExecute) +{ + // No DDE for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + rPar.Get(0)->PutEmpty(); + int nArgs = (int)rPar.Count(); + if ( nArgs != 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nChannel = rPar.Get(1)->GetInteger(); + const String& rCommand = rPar.Get(2)->GetString(); + SbiDdeControl* pDDE = pINST->GetDdeControl(); + SbError nDdeErr = pDDE->Execute( nChannel, rCommand ); + if( nDdeErr ) + StarBASIC::Error( nDdeErr ); +} + +RTLFUNC(DDEPoke) +{ + // No DDE for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + rPar.Get(0)->PutEmpty(); + int nArgs = (int)rPar.Count(); + if ( nArgs != 4 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nChannel = rPar.Get(1)->GetInteger(); + const String& rItem = rPar.Get(2)->GetString(); + const String& rData = rPar.Get(3)->GetString(); + SbiDdeControl* pDDE = pINST->GetDdeControl(); + SbError nDdeErr = pDDE->Poke( nChannel, rItem, rData ); + if( nDdeErr ) + StarBASIC::Error( nDdeErr ); +} + + +RTLFUNC(FreeFile) +{ + if ( rPar.Count() != 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + SbiIoSystem* pIO = pINST->GetIoSystem(); + short nChannel = 1; + while( nChannel < CHANNELS ) + { + SbiStream* pStrm = pIO->GetStream( nChannel ); + if( !pStrm ) + { + rPar.Get(0)->PutInteger( nChannel ); + return; + } + nChannel++; + } + StarBASIC::Error( SbERR_TOO_MANY_FILES ); +} + +RTLFUNC(LBound) +{ + USHORT nParCount = rPar.Count(); + if ( nParCount != 3 && nParCount != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + SbxBase* pParObj = rPar.Get(1)->GetObject(); + SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj); + if( pArr ) + { + short nLower, nUpper; + short nDim = (nParCount == 3) ? (short)rPar.Get(2)->GetInteger() : 1; + if( !pArr->GetDim( nDim, nLower, nUpper ) ) + StarBASIC::Error( SbERR_OUT_OF_RANGE ); + else + rPar.Get(0)->PutInteger( (INT16)nLower ); + } + else + StarBASIC::Error( SbERR_MUST_HAVE_DIMS ); +} + +RTLFUNC(UBound) +{ + USHORT nParCount = rPar.Count(); + if ( nParCount != 3 && nParCount != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + SbxBase* pParObj = rPar.Get(1)->GetObject(); + SbxDimArray* pArr = PTR_CAST(SbxDimArray,pParObj); + if( pArr ) + { + short nLower, nUpper; + short nDim = (nParCount == 3) ? (short)rPar.Get(2)->GetInteger() : 1; + if( !pArr->GetDim( nDim, nLower, nUpper ) ) + StarBASIC::Error( SbERR_OUT_OF_RANGE ); + else + rPar.Get(0)->PutInteger( (INT16)nUpper ); + } + else + StarBASIC::Error( SbERR_MUST_HAVE_DIMS ); +} + +RTLFUNC(RGB) +{ + if ( rPar.Count() != 4 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + ULONG nRed = rPar.Get(1)->GetInteger() & 0xFF; + ULONG nGreen = rPar.Get(2)->GetInteger() & 0xFF; + ULONG nBlue = rPar.Get(3)->GetInteger() & 0xFF; + ULONG nRGB = (nRed << 16) | (nGreen << 8) | nBlue; + rPar.Get(0)->PutLong( nRGB ); +} + +RTLFUNC(QBColor) +{ + if ( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + Color aCol( (ColorName)rPar.Get(1)->GetInteger() ); + + ULONG nRed = aCol.GetRed() >> 8; + ULONG nGreen = aCol.GetGreen() >> 8; + ULONG nBlue = aCol.GetBlue() >> 8; + ULONG nRGB = (nRed << 16) | (nGreen << 8) | nBlue; + rPar.Get(0)->PutLong( nRGB ); +} + + +RTLFUNC(StrConv) +{ + DBG_ASSERT(0,"StrConv:Not implemented"); +// if ( rPar.Count() != 3 ) +// { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +// return; +// } +} + +RTLFUNC(Beep) +{ + if ( rPar.Count() != 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + Sound::Beep(); +} + +RTLFUNC(Load) +{ + if( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + // Diesen Call einfach an das Object weiterreichen + SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject(); + if( pObj && pObj->IsA( TYPE( SbxObject ) ) ) + { + SbxVariable* pVar = ((SbxObject*)pObj)-> + Find( String( RTL_CONSTASCII_USTRINGPARAM("Load") ), SbxCLASS_METHOD ); + if( pVar ) + pVar->GetInteger(); + } +} + +RTLFUNC(Unload) +{ + rPar.Get(0)->PutEmpty(); + if( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + // Diesen Call einfach an das Object weitereichen + SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject(); + if( pObj && pObj->IsA( TYPE( SbxObject ) ) ) + { + SbxVariable* pVar = ((SbxObject*)pObj)-> + Find( String( RTL_CONSTASCII_USTRINGPARAM("Unload") ), SbxCLASS_METHOD ); + if( pVar ) + pVar->GetInteger(); + } +} + +RTLFUNC(LoadPicture) +{ + if( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + SbxObjectRef xRef = new SbStdPicture; + + SvFileStream aIStream( rPar.Get(1)->GetString(), STREAM_READ ); + Bitmap aBmp; + aIStream >> aBmp; + Graphic aGraphic( aBmp ); + ((SbStdPicture*)(SbxObject*)xRef)->SetGraphic( aGraphic ); + rPar.Get(0)->PutObject( xRef ); +} + +RTLFUNC(SavePicture) +{ + rPar.Get(0)->PutEmpty(); + if( rPar.Count() != 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + SbxBase* pObj = (SbxObject*)rPar.Get(1)->GetObject(); + if( pObj->IsA( TYPE( SbStdPicture ) ) ) + { + SvFileStream aOStream( rPar.Get(2)->GetString(), STREAM_WRITE | STREAM_TRUNC ); + Graphic aGraphic = ((SbStdPicture*)pObj)->GetGraphic(); + aOStream << aGraphic; + } +} + + +//----------------------------------------------------------------------------------------- +/* +class SbiAboutStarBasicDlg : public ModalDialog +{ + OKButton aOkButton; + Control aCtrl; + +public: + SbiAboutStarBasicDlg(); +}; + +SbiAboutStarBasicDlg::SbiAboutStarBasicDlg() : + ModalDialog( GetpApp()->GetAppWindow(), BasicResId( RID_BASIC_START ) ), + aOkButton( this, BasicResId( 1 ) ), + aCtrl( this, BasicResId( 1 ) ) +{ + FreeResource(); +} +*/ +//----------------------------------------------------------------------------------------- + +RTLFUNC(AboutStarBasic) +{ + /* + String aName; + if( rPar.Count() >= 2 ) + { + aName = rPar.Get(1)->GetString(); + } + + SbiAboutStarBasicDlg* pDlg = new SbiAboutStarBasicDlg; + pDlg->Execute(); + delete pDlg; + */ +} + +// MsgBox( msg [,type[,title]] ) + +RTLFUNC(MsgBox) +{ + static const WinBits nStyleMap[] = + { + WB_OK, // MB_OK + WB_OK_CANCEL, // MB_OKCANCEL + WB_RETRY_CANCEL, // MB_ABORTRETRYIGNORE + WB_YES_NO_CANCEL, // MB_YESNOCANCEL + WB_YES_NO, // MB_YESNO + WB_RETRY_CANCEL // MB_RETRYCANCEL + }; + static const INT16 nButtonMap[] = + { + 2, // #define RET_CANCEL FALSE + 1, // #define RET_OK TRUE + 6, // #define RET_YES 2 + 7, // #define RET_NO 3 + 4 // #define RET_RETRY 4 + }; + + + USHORT nArgCount = (USHORT)rPar.Count(); + if( nArgCount < 2 || nArgCount > 4 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + WinBits nWinBits; + WinBits nType = 0; // MB_OK + if( nArgCount >= 3 ) + nType = (WinBits)rPar.Get(2)->GetInteger(); + WinBits nStyle = nType; + nStyle &= 15; // Bits 4-16 loeschen + if( nStyle > 5 ) + nStyle = 0; + + nWinBits = nStyleMap[ nStyle ]; + if( nType & 4096 ) + nWinBits |= WB_SYSMODAL; + if( nType & 256 ) + { + if( nStyle == 5 || nStyle == 2) + nWinBits |= WB_DEF_CANCEL; + else + nWinBits |= (WB_DEF_CANCEL | WB_DEF_RETRY | WB_DEF_NO); + } + if( nType & 512 ) + nWinBits |= WB_DEF_CANCEL; + + String aMsg = rPar.Get(1)->GetString(); + String aTitle; + if( nArgCount == 4 ) + aTitle = rPar.Get(3)->GetString(); + else + aTitle = GetpApp()->GetAppName(); + + nType &= (16+32+64); + MessBox* pBox = 0; + Window* pParent = GetpApp()->GetDefModalDialogParent(); + switch( nType ) + { + case 16: + pBox = new ErrorBox( pParent, nWinBits, aMsg ); + break; + case 32: + pBox = new QueryBox( pParent, nWinBits, aMsg ); + break; + case 48: + pBox = new WarningBox( pParent, nWinBits, aMsg ); + break; + case 64: + pBox = new InfoBox( pParent, aMsg ); + break; + default: + pBox = new MessBox( pParent, nWinBits, aTitle, aMsg ); + } + pBox->SetText( aTitle ); + USHORT nRet = (USHORT)pBox->Execute(); + if( nRet == TRUE ) + nRet = 1; + rPar.Get(0)->PutInteger( nButtonMap[ nRet ] ); + delete pBox; +} + +RTLFUNC(SetAttr) // JSM +{ + rPar.Get(0)->PutEmpty(); + if ( rPar.Count() == 3 ) + { + String aStr = rPar.Get(1)->GetString(); + INT16 nFlags = rPar.Get(2)->GetInteger(); + + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + sal_Bool bReadOnly = (nFlags & 0x0001) != 0; // ATTR_READONLY + xSFI->setReadOnly( aStr, bReadOnly ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + // #57064 Bei virtuellen URLs den Real-Path extrahieren + DirEntry aEntry( aStr ); + String aFile = aEntry.GetFull(); + #ifdef WIN + int nErr = _dos_setfileattr( aFile.GetStr(),(unsigned ) nFlags ); + if ( nErr ) + { + if (errno == EACCES) + StarBASIC::Error( SbERR_ACCESS_DENIED ); + else + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + } + #endif + ByteString aByteFile( aFile, gsl_getSystemTextEncoding() ); + #ifdef WNT + if (!SetFileAttributes (aByteFile.GetBuffer(),(DWORD)nFlags)) + StarBASIC::Error(SbERR_FILE_NOT_FOUND); + #endif + #ifdef OS2 + FILESTATUS3 aFileStatus; + APIRET rc = DosQueryPathInfo(aByteFile.GetBuffer(),1, + &aFileStatus,sizeof(FILESTATUS3)); + if (!rc) + { + if (aFileStatus.attrFile != nFlags) + { + aFileStatus.attrFile = nFlags; + rc = DosSetPathInfo(aFile.GetStr(),1, + &aFileStatus,sizeof(FILESTATUS3),0); + if (rc) + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + } + } + else + StarBASIC::Error( SbERR_FILE_NOT_FOUND ); + #endif + } + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(Reset) // JSM +{ + SbiIoSystem* pIO = pINST->GetIoSystem(); + if (pIO) + pIO->CloseAll(); +} + +RTLFUNC(DumpAllObjects) +{ + USHORT nArgCount = (USHORT)rPar.Count(); + if( nArgCount < 2 || nArgCount > 3 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else if( !pBasic ) + StarBASIC::Error( SbERR_INTERNAL_ERROR ); + else + { + SbxObject* p = pBasic; + while( p->GetParent() ) + p = p->GetParent(); + SvFileStream aStrm( rPar.Get( 1 )->GetString(), + STREAM_WRITE | STREAM_TRUNC ); + p->Dump( aStrm, rPar.Get( 2 )->GetBool() ); + aStrm.Close(); + if( aStrm.GetError() != SVSTREAM_OK ) + StarBASIC::Error( SbERR_IO_ERROR ); + } +} + + +RTLFUNC(FileExists) +{ + if ( rPar.Count() == 2 ) + { + String aStr = rPar.Get(1)->GetString(); + BOOL bExists = FALSE; + + // <-- UCB + if( hasUno() ) + { + Reference< XSimpleFileAccess > xSFI = getFileAccess(); + if( xSFI.is() ) + { + try + { + bExists = xSFI->exists( aStr ); + } + catch( Exception & ) + { + StarBASIC::Error( ERRCODE_IO_GENERAL ); + } + } + } + else + // --> UCB + { + DirEntry aEntry( aStr ); + bExists = aEntry.Exists(); + } + rPar.Get(0)->PutBool( bExists ); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + diff --git a/basic/source/runtime/methods1.cxx b/basic/source/runtime/methods1.cxx new file mode 100644 index 000000000000..5265ec824324 --- /dev/null +++ b/basic/source/runtime/methods1.cxx @@ -0,0 +1,1266 @@ +/************************************************************************* + * + * $RCSfile: methods1.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#if defined(WIN) +#include <string.h> +#else +#include <stdlib.h> // getenv +#endif + +#ifndef NOOLDSV //autogen +#include <vcl/system.hxx> +#endif +#ifndef _SV_SVAPP_HXX //autogen +#include <vcl/svapp.hxx> +#endif +#ifndef _SV_MAPMOD_HXX +#include <vcl/mapmod.hxx> +#endif +#ifndef _SV_WRKWIN_HXX +#include <vcl/wrkwin.hxx> +#endif +#ifndef _SBXVAR_HXX +#include <svtools/sbxvar.hxx> +#endif +#ifndef _SBX_HXX +#include <svtools/sbx.hxx> +#endif +#ifndef _FSYS_HXX +#include <tools/fsys.hxx> +#endif + +#ifdef OS2 +#define INCL_DOS +#define INCL_DOSPROCESS +#include <tools/svpm.h> +#include <vcl/sysdep.hxx> +#endif + +#if defined(WIN) +#ifndef _SVWIN_H +#include <tools/svwin.h> +#endif +#endif + +#ifndef OS2 +#include <time.h> +#endif + +#ifndef CLK_TCK +#define CLK_TCK CLOCKS_PER_SEC +#endif + +#ifdef VCL +#include <vcl/jobset.hxx> +#else +#include <vcl/jobset.hxx> +#endif + +#pragma hdrstop +#include "sbintern.hxx" +#include "runtime.hxx" +#include "stdobj.hxx" +#include "rtlproto.hxx" +#include "dllmgr.hxx" +#include <iosys.hxx> +#ifndef SB_UNO_OBJ +#include "sbunoobj.hxx" +#endif +#include "propacc.hxx" + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + + +#if defined (OS2) && defined (__BORLANDC__) +#pragma option -w-par +#endif + +static BOOL Convert (SbxDataType eType, + SbxValue &rSbxValue, + SbxVariable *pSbxVariable) +{ + return TRUE; +} + +RTLFUNC(CBool) // JSM +{ + BOOL bVal = FALSE; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + bVal = pSbxVariable->GetBool(); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutBool(bVal); +} + +RTLFUNC(CByte) // JSM +{ + BYTE nByte = 0; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + nByte = pSbxVariable->GetByte(); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutByte(nByte); +} + +RTLFUNC(CCur) // JSM +{ + rPar.Get(0)->PutEmpty(); + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); +} + +RTLFUNC(CDate) // JSM +{ + double nVal = 0.0; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + nVal = pSbxVariable->GetDate(); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutDate(nVal); +} + +RTLFUNC(CDbl) // JSM +{ + double nVal = 0.0; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + if( pSbxVariable->GetType() == SbxSTRING ) + { + SbxError eOld = SbxBase::GetError(); + if( eOld != SbxERR_OK ) + SbxBase::ResetError(); + + // AB #42529 , zunaechst Wandlung in Date versuchen + // Wenn erfolgreich, ist das das Ergebnis + nVal = pSbxVariable->GetDate(); + if( SbxBase::GetError() != SbxERR_OK ) + { + SbxBase::ResetError(); + if( eOld != SbxERR_OK ) + SbxBase::SetError( eOld ); + + // AB #41690 , String holen + String aScanStr = pSbxVariable->GetString(); + SbError Error = SbxValue::ScanNumIntnl( aScanStr, nVal ); + if( Error != SbxERR_OK ) + StarBASIC::Error( Error ); + } + } + else + { + nVal = pSbxVariable->GetDouble(); + } + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutDouble(nVal); +} + +RTLFUNC(CInt) // JSM +{ + INT16 nVal = 0; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + nVal = pSbxVariable->GetInteger(); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutInteger(nVal); +} + +RTLFUNC(CLng) // JSM +{ + INT32 nVal = 0; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + nVal = pSbxVariable->GetLong(); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutLong(nVal); +} + +RTLFUNC(CSng) // JSM +{ + float nVal = (float)0.0; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + if( pSbxVariable->GetType() == SbxSTRING ) + { + SbxError eOld = SbxBase::GetError(); + if( eOld != SbxERR_OK ) + SbxBase::ResetError(); + + // AB #42529 , zunaechst Wandlung in Date versuchen + // Wenn erfolgreich, ist das das Ergebnis + double dVal = pSbxVariable->GetDate(); + if( SbxBase::GetError() != SbxERR_OK ) + { + SbxBase::ResetError(); + if( eOld != SbxERR_OK ) + SbxBase::SetError( eOld ); + + // AB #41690 , String holen + String aScanStr = pSbxVariable->GetString(); + SbError Error = SbxValue::ScanNumIntnl( aScanStr, dVal, /*bSingle=*/TRUE ); + if( SbxBase::GetError() == SbxERR_OK && Error != SbxERR_OK ) + StarBASIC::Error( Error ); + } + nVal = (float)dVal; + } + else + { + nVal = pSbxVariable->GetSingle(); + } + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutSingle(nVal); +} + +RTLFUNC(CStr) // JSM +{ + String aString; + if ( rPar.Count() == 2 ) + { + SbxVariable *pSbxVariable = rPar.Get(1); + aString = pSbxVariable->GetString(); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + + rPar.Get(0)->PutString(aString); +} + +RTLFUNC(CVar) // JSM +{ + rPar.Get(0)->PutEmpty(); + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); +} + +RTLFUNC(CVErr) // JSM +{ + rPar.Get(0)->PutEmpty(); + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); +} + +RTLFUNC(Iif) // JSM +{ + if ( rPar.Count() == 4 ) + { + if (rPar.Get(1)->GetBool()) + *rPar.Get(0) = *rPar.Get(2); + else + *rPar.Get(0) = *rPar.Get(3); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(GetSystemType) +{ + if ( rPar.Count() != 1 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + // Removed for SRC595 + rPar.Get(0)->PutInteger( -1 ); +} + +RTLFUNC(GetGUIType) +{ + if ( rPar.Count() != 1 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + // 17.7.2000 Make simple solution for testtool / fat office +#if defined (WNT) || (defined (OS2) && !defined (WTC)) + rPar.Get(0)->PutInteger( 1 ); +#elif defined OS2 + rPar.Get(0)->PutInteger( 2 ); +#elif defined UNX + rPar.Get(0)->PutInteger( 4 ); +#elif + rPar.Get(0)->PutInteger( -1 ); +#endif + } +} + +RTLFUNC(Red) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + ULONG nRGB = (ULONG)rPar.Get(1)->GetLong(); + nRGB &= 0x00FF0000; + nRGB >>= 16; + rPar.Get(0)->PutInteger( (INT16)nRGB ); + } +} + +RTLFUNC(Green) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + ULONG nRGB = (ULONG)rPar.Get(1)->GetLong(); + nRGB &= 0x0000FF00; + nRGB >>= 8; + rPar.Get(0)->PutInteger( (INT16)nRGB ); + } +} + +RTLFUNC(Blue) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + ULONG nRGB = (ULONG)rPar.Get(1)->GetLong(); + nRGB &= 0x000000FF; + rPar.Get(0)->PutInteger( (INT16)nRGB ); + } +} + + +RTLFUNC(Switch) +{ + USHORT nCount = rPar.Count(); + if( !(nCount & 0x0001 )) + // Anzahl der Argumente muss ungerade sein + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + USHORT nCurExpr = 1; + while( nCurExpr < (nCount-1) ) + { + if( rPar.Get( nCurExpr )->GetBool()) + { + (*rPar.Get(0)) = *(rPar.Get(nCurExpr+1)); + return; + } + nCurExpr += 2; + } + rPar.Get(0)->PutNull(); +} + + +RTLFUNC(Wait) +{ + if( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + long nWait = rPar.Get(1)->GetLong(); + if( nWait < 0 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } +#if defined(OS2) + ULONG nStart, nCur; + DosQuerySysInfo( QSV_MS_COUNT, QSV_MS_COUNT,&nStart,sizeof(ULONG) ); + // drucken wir gerade? + int bPrinting = Sysdepen::IsMultiThread() ? TRUE : FALSE; + do + { + Application::Reschedule(); + if( bPrinting ) + DosSleep( 50 ); // damit der Druck-Thread mehr CPU-Zeit bekommt + DosQuerySysInfo( QSV_MS_COUNT, QSV_MS_COUNT,&nCur,sizeof(ULONG) ); + } while( (nCur-nStart) < (ULONG)nWait ); +#else + long nSeconds = nWait / 1000; + if( !nSeconds ) nSeconds = 1; +#if defined(UNX) || defined(WIN) + // Unix hat kein clock() + time_t nStart = time( 0 ); + time_t nEnd; + do + { + Application::Reschedule(); + nEnd = time( 0 ); + } while( (nEnd-nStart) < nSeconds ); +#else + clock_t nStart = clock() / CLK_TCK; + clock_t nEnd; + do + { + Application::Reschedule(); + nEnd = clock() / CLK_TCK; + } while( (nEnd-nStart) < nSeconds ); +#endif + +#endif +} + +RTLFUNC(GetGUIVersion) +{ + if ( rPar.Count() != 1 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + // Removed for SRC595 + rPar.Get(0)->PutLong( -1 ); + } +} + +RTLFUNC(Choose) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + INT16 nIndex = rPar.Get(1)->GetInteger(); + USHORT nCount = rPar.Count(); + nCount--; + if( nCount == 1 || nIndex > (nCount-1) || nIndex < 1 ) + { + rPar.Get(0)->PutNull(); + return; + } + (*rPar.Get(0)) = *(rPar.Get(nIndex+1)); +} + + +RTLFUNC(Trim) +{ + if ( rPar.Count() < 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + String aStr( rPar.Get(1)->GetString() ); + aStr.EraseLeadingChars(); + aStr.EraseTrailingChars(); + rPar.Get(0)->PutString( aStr ); + } +} + +RTLFUNC(DateAdd) +{ +} + +RTLFUNC(DateDiff) +{ +} + +RTLFUNC(DatePart) +{ +} + + +RTLFUNC(GetSolarVersion) +{ + rPar.Get(0)->PutLong( (INT32)SUPD ); +} + +RTLFUNC(TwipsPerPixelX) +{ + Size aSize( 100,0 ); + MapMode aMap( MAP_TWIP ); + aSize = GetpApp()->GetAppWindow()->PixelToLogic( aSize, aMap ); + aSize.Width() /= 100; + rPar.Get(0)->PutLong( aSize.Width() ); +} + +RTLFUNC(TwipsPerPixelY) +{ + Size aSize( 0,100 ); + MapMode aMap( MAP_TWIP ); + aSize = GetpApp()->GetAppWindow()->PixelToLogic( aSize, aMap ); + aSize.Height() /= 100; + rPar.Get(0)->PutLong( aSize.Height() ); +} + + +RTLFUNC(FreeLibrary) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + ByteString aByteDLLName( rPar.Get(1)->GetString(), gsl_getSystemTextEncoding() ); + pINST->GetDllMgr()->FreeDll( aByteDLLName ); +} + +RTLFUNC(Array) +{ + SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); + USHORT nArraySize = rPar.Count() - 1; + + // Option Base zunaechst ignorieren (kennt leider nur der Compiler) + if( nArraySize ) + pArray->AddDim( 0, nArraySize-1 ); + + // Parameter ins Array uebernehmen + for( short i = 0 ; i < nArraySize ; i++ ) + pArray->Put( rPar.Get(i+1), &i ); + + // Array zurueckliefern + SbxVariableRef refVar = rPar.Get(0); + USHORT nFlags = refVar->GetFlags(); + refVar->ResetFlag( SBX_FIXED ); + refVar->PutObject( pArray ); + refVar->SetFlags( nFlags ); + refVar->SetParameters( NULL ); +} + + +// Featurewunsch #57868 +// Die Funktion liefert ein Variant-Array, wenn keine Parameter angegeben +// werden, wird ein leeres Array erzeugt (entsprechend dim a(), entspricht +// einer Sequence der Laenge 0 in Uno). +// Wenn Parameter angegeben sind, wird fuer jeden eine Dimension erzeugt +// DimArray( 2, 2, 4 ) entspricht DIM a( 2, 2, 4 ) +// Das Array ist immer vom Typ Variant +RTLFUNC(DimArray) +{ + SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); + USHORT nArrayDims = rPar.Count() - 1; + if( nArrayDims > 0 ) + { + for( USHORT i = 0; i < nArrayDims ; i++ ) + { + INT16 ub = rPar.Get(i+1)->GetInteger(); + if( ub < 0 ) + { + StarBASIC::Error( SbERR_OUT_OF_RANGE ); + ub = 0; + } + pArray->AddDim( 0, ub ); + } + } + // Array zurueckliefern + SbxVariableRef refVar = rPar.Get(0); + USHORT nFlags = refVar->GetFlags(); + refVar->ResetFlag( SBX_FIXED ); + refVar->PutObject( pArray ); + refVar->SetFlags( nFlags ); + refVar->SetParameters( NULL ); +} + +/* + * FindObject und FindPropertyObject ermoeglichen es, + * Objekte und Properties vom Typ Objekt zur Laufzeit + * ueber ihren Namen als String-Parameter anzusprechen. + * + * Bsp.: + * MyObj.Prop1.Bla = 5 + * + * entspricht: + * dim ObjVar as Object + * dim ObjProp as Object + * ObjName$ = "MyObj" + * ObjVar = FindObject( ObjName$ ) + * PropName$ = "Prop1" + * ObjProp = FindPropertyObject( ObjVar, PropName$ ) + * ObjProp.Bla = 5 + * + * Dabei koennen die Namen zur Laufzeit dynamisch + * erzeugt werden und, so dass z.B. ueber Controls + * "TextEdit1" bis "TextEdit5" in einem Dialog in + * einer Schleife iteriert werden kann. + */ + +// Objekt ueber den Namen ansprechen +// 1. Parameter = Name des Objekts als String +RTLFUNC(FindObject) +{ + // Wir brauchen einen Parameter + if ( rPar.Count() < 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + // 1. Parameter ist der Name + String aNameStr = rPar.Get(1)->GetString(); + + // Basic-Suchfunktion benutzen + SbxBase* pFind = StarBASIC::FindSBXInCurrentScope( aNameStr ); + SbxObject* pFindObj = NULL; + if( pFind ) + pFindObj = PTR_CAST(SbxObject,pFind); + /* + if( !pFindObj ) + { + StarBASIC::Error( SbERR_VAR_UNDEFINED ); + return; + } + */ + + // Objekt zurueckliefern + SbxVariableRef refVar = rPar.Get(0); + refVar->PutObject( pFindObj ); +} + +// Objekt-Property in einem Objekt ansprechen +// 1. Parameter = Objekt +// 2. Parameter = Name der Property als String +RTLFUNC(FindPropertyObject) +{ + // Wir brauchen 2 Parameter + if ( rPar.Count() < 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + // 1. Parameter holen, muss Objekt sein + SbxBase* pObjVar = (SbxObject*)rPar.Get(1)->GetObject(); + SbxObject* pObj = NULL; + if( pObjVar ) + pObj = PTR_CAST(SbxObject,pObjVar); + if( !pObj && pObjVar && pObjVar->ISA(SbxVariable) ) + { + SbxBase* pObjVarObj = ((SbxVariable*)pObjVar)->GetObject(); + pObj = PTR_CAST(SbxObject,pObjVarObj); + } + /* + if( !pObj ) + { + StarBASIC::Error( SbERR_VAR_UNDEFINED ); + return; + } + */ + + // 2. Parameter ist der Name + String aNameStr = rPar.Get(2)->GetString(); + + // Jetzt muss ein Objekt da sein, sonst Error + SbxObject* pFindObj = NULL; + if( pObj ) + { + // Im Objekt nach Objekt suchen + SbxVariable* pFindVar = pObj->Find( aNameStr, SbxCLASS_OBJECT ); + pFindObj = PTR_CAST(SbxObject,pFindVar); + } + else + StarBASIC::Error( SbERR_BAD_PARAMETER ); + + // Objekt zurueckliefern + SbxVariableRef refVar = rPar.Get(0); + refVar->PutObject( pFindObj ); +} + + + +BOOL lcl_WriteSbxVariable( const SbxVariable& rVar, SvStream* pStrm, + BOOL bBinary, short nBlockLen, BOOL bIsArray ) +{ + ULONG nFPos = pStrm->Tell(); + + BOOL bIsVariant = !rVar.IsFixed(); + SbxDataType eType = rVar.GetType(); + + switch( eType ) + { + case SbxBOOL: + case SbxCHAR: + case SbxBYTE: + if( bIsVariant ) + *pStrm << (USHORT)SbxBYTE; // VarType Id + *pStrm << rVar.GetByte(); + break; + + case SbxEMPTY: + case SbxNULL: + case SbxVOID: + case SbxINTEGER: + case SbxUSHORT: + case SbxINT: + case SbxUINT: + if( bIsVariant ) + *pStrm << (USHORT)SbxINTEGER; // VarType Id + *pStrm << rVar.GetInteger(); + break; + + case SbxLONG: + case SbxULONG: + case SbxLONG64: + case SbxULONG64: + if( bIsVariant ) + *pStrm << (USHORT)SbxLONG; // VarType Id + *pStrm << rVar.GetLong(); + break; + + case SbxSINGLE: + if( bIsVariant ) + *pStrm << (USHORT)eType; // VarType Id + *pStrm << rVar.GetSingle(); + break; + + case SbxDOUBLE: + case SbxCURRENCY: + case SbxDATE: + if( bIsVariant ) + *pStrm << (USHORT)eType; // VarType Id + *pStrm << rVar.GetDouble(); + break; + + case SbxSTRING: + case SbxLPSTR: + { + const String& rStr = rVar.GetString(); + if( !bBinary || bIsArray ) + { + if( bIsVariant ) + *pStrm << (USHORT)SbxSTRING; + pStrm->WriteByteString( rStr, gsl_getSystemTextEncoding() ); + //*pStrm << rStr; + } + else + { + // ohne Laengenangabe! ohne Endekennung! + // What does that mean for Unicode?! Choosing conversion to ByteString... + ByteString aByteStr( rStr, gsl_getSystemTextEncoding() ); + *pStrm << (const char*)aByteStr.GetBuffer(); + //*pStrm << (const char*)rStr.GetStr(); + } + } + break; + + default: + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return FALSE; + } + + if( nBlockLen ) + pStrm->Seek( nFPos + nBlockLen ); + return pStrm->GetErrorCode() ? FALSE : TRUE; +} + +BOOL lcl_ReadSbxVariable( SbxVariable& rVar, SvStream* pStrm, + BOOL bBinary, short nBlockLen, BOOL bIsArray ) +{ + double aDouble; + + ULONG nFPos = pStrm->Tell(); + + BOOL bIsVariant = !rVar.IsFixed(); + SbxDataType eVarType = rVar.GetType(); + + SbxDataType eSrcType = eVarType; + if( bIsVariant ) + { + USHORT nTemp; + *pStrm >> nTemp; + eSrcType = (SbxDataType)nTemp; + } + + switch( eSrcType ) + { + case SbxBOOL: + case SbxCHAR: + case SbxBYTE: + { + BYTE aByte; + *pStrm >> aByte; + rVar.PutByte( aByte ); + } + break; + + case SbxEMPTY: + case SbxNULL: + case SbxVOID: + case SbxINTEGER: + case SbxUSHORT: + case SbxINT: + case SbxUINT: + { + INT16 aInt; + *pStrm >> aInt; + rVar.PutInteger( aInt ); + } + break; + + case SbxLONG: + case SbxULONG: + case SbxLONG64: + case SbxULONG64: + { + INT32 aInt; + *pStrm >> aInt; + rVar.PutLong( aInt ); + } + break; + + case SbxSINGLE: + { + float nS; + *pStrm >> nS; + rVar.PutSingle( nS ); + } + break; + + case SbxDOUBLE: + case SbxCURRENCY: + { + *pStrm >> aDouble; + rVar.PutDouble( aDouble ); + } + break; + + case SbxDATE: + { + *pStrm >> aDouble; + rVar.PutDate( aDouble ); + } + break; + + case SbxSTRING: + case SbxLPSTR: + { + String aStr; + pStrm->ReadByteString( aStr, gsl_getSystemTextEncoding() ); + rVar.PutString( aStr ); + } + break; + + default: + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return FALSE; + } + + if( nBlockLen ) + pStrm->Seek( nFPos + nBlockLen ); + return pStrm->GetErrorCode() ? FALSE : TRUE; +} + + +// nCurDim = 1...n +BOOL lcl_WriteReadSbxArray( SbxDimArray& rArr, SvStream* pStrm, + BOOL bBinary, short nCurDim, short* pOtherDims, BOOL bWrite ) +{ + DBG_ASSERT( nCurDim > 0,"Bad Dim"); + short nLower, nUpper; + if( !rArr.GetDim( nCurDim, nLower, nUpper ) ) + return FALSE; + for( short nCur = nLower; nCur <= nUpper; nCur++ ) + { + pOtherDims[ nCurDim-1 ] = nCur; + if( nCurDim != 1 ) + lcl_WriteReadSbxArray(rArr, pStrm, bBinary, nCurDim-1, pOtherDims, bWrite); + else + { + SbxVariable* pVar = rArr.Get( (const short*)pOtherDims ); + BOOL bRet; + if( bWrite ) + bRet = lcl_WriteSbxVariable(*pVar, pStrm, bBinary, 0, TRUE ); + else + bRet = lcl_ReadSbxVariable(*pVar, pStrm, bBinary, 0, TRUE ); + if( !bRet ) + return FALSE; + } + } + return TRUE; +} + +void PutGet( SbxArray& rPar, BOOL bPut ) +{ + // Wir brauchen 3 Parameter + if ( rPar.Count() != 4 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + INT16 nFileNo = rPar.Get(1)->GetInteger(); + SbxVariable* pVar2 = rPar.Get(2); + BOOL bHasRecordNo = (BOOL)(pVar2->GetType() != SbxEMPTY); + long nRecordNo = pVar2->GetLong(); + if ( nFileNo < 1 || ( bHasRecordNo && nRecordNo < 1 ) ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + nRecordNo--; // wir moegen's ab 0! + SbiIoSystem* pIO = pINST->GetIoSystem(); + SbiStream* pSbStrm = pIO->GetStream( nFileNo ); + // das File muss Random (feste Record-Laenge) oder Binary sein + if ( !pSbStrm || !(pSbStrm->GetMode() & (SBSTRM_BINARY | SBSTRM_RANDOM)) ) + { + StarBASIC::Error( SbERR_BAD_CHANNEL ); + return; + } + + SvStream* pStrm = pSbStrm->GetStrm(); + BOOL bRandom = pSbStrm->IsRandom(); + short nBlockLen = bRandom ? pSbStrm->GetBlockLen() : 0; + + if( bPut ) + { + // Datei aufplustern, falls jemand uebers Dateiende hinaus geseekt hat + pSbStrm->ExpandFile(); + } + + // auf die Startposition seeken + if( bHasRecordNo ) + { + ULONG nFilePos = bRandom ? (ULONG)(nBlockLen*nRecordNo) : (ULONG)nRecordNo; + pStrm->Seek( nFilePos ); + } + + SbxDimArray* pArr = 0; + SbxVariable* pVar = rPar.Get(3); + if( pVar->GetType() & SbxARRAY ) + { + SbxBase* pParObj = pVar->GetObject(); + pArr = PTR_CAST(SbxDimArray,pParObj); + } + + BOOL bRet; + + if( pArr ) + { + ULONG nFPos = pStrm->Tell(); + short nDims = pArr->GetDims(); + short* pDims = new short[ nDims ]; + bRet = lcl_WriteReadSbxArray(*pArr,pStrm,!bRandom,nDims,pDims,bPut); + delete pDims; + if( nBlockLen ) + pStrm->Seek( nFPos + nBlockLen ); + } + else + { + if( bPut ) + bRet = lcl_WriteSbxVariable(*pVar, pStrm, !bRandom, nBlockLen, FALSE); + else + bRet = lcl_ReadSbxVariable(*pVar, pStrm, !bRandom, nBlockLen, FALSE); + } + if( !bRet || pStrm->GetErrorCode() ) + StarBASIC::Error( SbERR_IO_ERROR ); +} + +RTLFUNC(Put) +{ + PutGet( rPar, TRUE ); +} + +RTLFUNC(Get) +{ + PutGet( rPar, FALSE ); +} + +RTLFUNC(Environ) +{ + if ( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + String aResult; + // sollte ANSI sein, aber unter Win16 in DLL nicht moeglich +#if defined(WIN) + LPSTR lpszEnv = GetDOSEnvironment(); + String aCompareStr( rPar.Get(1)->GetString() ); + aCompareStr += '='; + const char* pCompare = aCompareStr.GetStr(); + int nCompareLen = aCompareStr.Len(); + while ( *lpszEnv ) + { + // Es werden alle EnvString in der Form ENV=VAL 0-terminiert + // aneinander gehaengt. + + if ( strnicmp( pCompare, lpszEnv, nCompareLen ) == 0 ) + { + aResult = (const char*)(lpszEnv+nCompareLen); + rPar.Get(0)->PutString( aResult ); + return; + } + lpszEnv += lstrlen( lpszEnv ) + 1; // Next Enviroment-String + } +#else + ByteString aByteStr( rPar.Get(1)->GetString(), gsl_getSystemTextEncoding() ); + const char* pEnvStr = getenv( aByteStr.GetBuffer() ); + if ( pEnvStr ) + aResult = String::CreateFromAscii( pEnvStr ); +#endif + rPar.Get(0)->PutString( aResult ); +} + +static double GetDialogZoomFactor( BOOL bX, long nValue ) +{ + Size aRefSize( nValue, nValue ); +#ifndef WIN + Fraction aFracX( 1, 26 ); +#else + Fraction aFracX( 1, 23 ); +#endif + Fraction aFracY( 1, 24 ); + MapMode aMap( MAP_APPFONT, Point(), aFracX, aFracY ); + Window* pWin = GetpApp()->GetAppWindow(); + Size aScaledSize = pWin->LogicToPixel( aRefSize, aMap ); + aRefSize = pWin->LogicToPixel( aRefSize, MapMode(MAP_TWIP) ); + double nRef, nScaled, nResult; + if( bX ) + { + nRef = aRefSize.Width(); + nScaled = aScaledSize.Width(); + } + else + { + nRef = aRefSize.Height(); + nScaled = aScaledSize.Height(); + } + nResult = nScaled / nRef; + return nResult; +} + + +RTLFUNC(GetDialogZoomFactorX) +{ + if ( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + rPar.Get(0)->PutDouble( GetDialogZoomFactor( TRUE, rPar.Get(1)->GetLong() )); +} + +RTLFUNC(GetDialogZoomFactorY) +{ + if ( rPar.Count() != 2 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + rPar.Get(0)->PutDouble( GetDialogZoomFactor( FALSE, rPar.Get(1)->GetLong())); +} + + +RTLFUNC(EnableReschedule) +{ + rPar.Get(0)->PutEmpty(); + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + if( pINST ) + pINST->EnableReschedule( rPar.Get(1)->GetBool() ); +} + +RTLFUNC(GetSystemTicks) +{ + if ( rPar.Count() != 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + rPar.Get(0)->PutLong( Time::GetSystemTicks() ); +} + +RTLFUNC(GetPathSeparator) +{ + if ( rPar.Count() != 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + rPar.Get(0)->PutString( DirEntry::GetAccessDelimiter() ); +} + +RTLFUNC(ResolvePath) +{ + if ( rPar.Count() == 2 ) + { + String aStr = rPar.Get(1)->GetString(); + DirEntry aEntry( aStr ); + //if( aEntry.IsVirtual() ) + //aStr = aEntry.GetRealPathFromVirtualURL(); + rPar.Get(0)->PutString( aStr ); + } + else + StarBASIC::Error( SbERR_BAD_ARGUMENT ); +} + +RTLFUNC(TypeLen) +{ + if ( rPar.Count() != 2 ) + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + else + { + SbxDataType eType = rPar.Get(1)->GetType(); + INT16 nLen = 0; + switch( eType ) + { + case SbxEMPTY: + case SbxNULL: + case SbxVECTOR: + case SbxARRAY: + case SbxBYREF: + case SbxVOID: + case SbxHRESULT: + case SbxPOINTER: + case SbxDIMARRAY: + case SbxCARRAY: + case SbxUSERDEF: + nLen = 0; + break; + + case SbxINTEGER: + case SbxERROR: + case SbxUSHORT: + case SbxINT: + case SbxUINT: + nLen = 2; + break; + + case SbxLONG: + case SbxSINGLE: + case SbxULONG: + nLen = 4; + break; + + case SbxDOUBLE: + case SbxCURRENCY: + case SbxDATE: + case SbxLONG64: + case SbxULONG64: + nLen = 8; + break; + + case SbxOBJECT: + case SbxVARIANT: + case SbxDATAOBJECT: + nLen = 0; + break; + + case SbxCHAR: + case SbxBYTE: + case SbxBOOL: + nLen = 1; + break; + + case SbxLPSTR: + case SbxLPWSTR: + case SbxCoreSTRING: + case SbxSTRING: + nLen = (INT16)rPar.Get(1)->GetString().Len(); + break; + + default: + nLen = 0; + } + rPar.Get(0)->PutInteger( nLen ); + } +} + + +// Uno-Struct eines beliebigen Typs erzeugen +// 1. Parameter == Klassename, weitere Parameter zur Initialisierung +RTLFUNC(CreateUnoStruct) +{ + RTL_Impl_CreateUnoStruct( pBasic, rPar, bWrite ); +} + +// Uno-Service erzeugen +// 1. Parameter == Service-Name +RTLFUNC(CreateUnoService) +{ + RTL_Impl_CreateUnoService( pBasic, rPar, bWrite ); +} + +// ServiceManager liefern (keine Parameter) +RTLFUNC(GetProcessServiceManager) +{ + RTL_Impl_GetProcessServiceManager( pBasic, rPar, bWrite ); +} + +// PropertySet erzeugen +// 1. Parameter == Sequence<PropertyValue> +RTLFUNC(CreatePropertySet) +{ + RTL_Impl_CreatePropertySet( pBasic, rPar, bWrite ); +} + +// Abfragen, ob ein Interface unterstuetzt wird +// Mehrere Interface-Namen als Parameter +RTLFUNC(HasUnoInterfaces) +{ + RTL_Impl_HasInterfaces( pBasic, rPar, bWrite ); +} + +// Abfragen, ob ein Basic-Objekt ein Uno-Struct repraesentiert +RTLFUNC(IsUnoStruct) +{ + RTL_Impl_IsUnoStruct( pBasic, rPar, bWrite ); +} + +// Abfragen, ob zwei Uno-Objekte identisch sind +RTLFUNC(EqualUnoObjects) +{ + RTL_Impl_EqualUnoObjects( pBasic, rPar, bWrite ); +} + diff --git a/basic/source/runtime/os2.asm b/basic/source/runtime/os2.asm new file mode 100644 index 000000000000..c50f2233ec87 --- /dev/null +++ b/basic/source/runtime/os2.asm @@ -0,0 +1,89 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; OS2.ASM +;; +;; Ersterstellung MD 30.05.94 +;; +;; Anmerkungen +;; Direktaufruf von C- und PASCAL-Routinen, OS/2 +;; +;; Source Code Control System - Header +;; $Header: /zpool/svn/migration/cvs_rep_09_09_08/code/basic/source/runtime/os2.asm,v 1.1.1.1 2000-09-18 16:12:11 hr Exp $ +;; +;; Copyright (c) 1990,95 by STAR DIVISION GmbH +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; Inhalt: +; type = CallXXX (far *proc, char *stack, short nstack) +; +; Kopie des Basic-Stacks (nstack Bytes) auf den C-Stack +; und Aufruf der Prozedur. + + .386 + .MODEL FLAT + + .CODE + + PUBLIC CallINT + PUBLIC CallLNG + PUBLIC CallSNG + PUBLIC CallDBL + PUBLIC CallSTR + PUBLIC CallFIX + + PUBLIC _CallINT + PUBLIC _CallLNG + PUBLIC _CallSNG + PUBLIC _CallDBL + PUBLIC _CallSTR + PUBLIC _CallFIX + +_CallINT LABEL byte +_CallLNG LABEL byte +_CallSNG LABEL byte +_CallDBL LABEL byte +_CallSTR LABEL byte +_CallFIX LABEL byte + +CallINT LABEL byte +CallLNG LABEL byte +CallSNG LABEL byte +CallDBL LABEL byte +CallSTR LABEL byte +CallFIX PROC + +p EQU [EBP+8] +stk EQU [EBP+12] +n EQU [EBP+16] + + PUSH EBP + MOV EBP,ESP + PUSH ESI + PUSH EDI + MOV DX,DS + MOVZX ECX,word ptr [n] + SUB ESP,ECX + MOV EDI,ESP + MOV AX,SS + MOV ES,AX + MOV ESI,[stk] + SHR ECX,1 + CLD + JCXZ $1 + REP MOVSW ; Stack uebernehmen +$1: MOV DS,DX + CALL LARGE [p] ; 32-bit + MOV ECX,EBP + SUB ECX,8 ; wegen gepushter Register + MOV ESP,ECX + POP EDI + POP ESI + POP EBP +; Bei Borland C++ Calling Convention: +; RET 12 +; CSet System-Calling Convention + RET +CallFIX ENDP + + END diff --git a/basic/source/runtime/props.cxx b/basic/source/runtime/props.cxx new file mode 100644 index 000000000000..7c43f22b5dc5 --- /dev/null +++ b/basic/source/runtime/props.cxx @@ -0,0 +1,504 @@ +/************************************************************************* + * + * $RCSfile: props.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#include <svtools/sbx.hxx> +#include "runtime.hxx" +#pragma hdrstop +#include "stdobj.hxx" +#include "rtlproto.hxx" + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +#if defined (OS2) && defined (__BORLANDC__) +#pragma option -w-par +#endif + + +// Properties und Methoden legen beim Get (bWrite = FALSE) den Returnwert +// im Element 0 des Argv ab; beim Put (bWrite = TRUE) wird der Wert aus +// Element 0 gespeichert. + +RTLFUNC(Erl) +{ + rPar.Get( 0 )->PutLong( StarBASIC::GetErl() ); +} + +RTLFUNC(Err) +{ + if( bWrite ) + { + INT32 nVal = rPar.Get( 0 )->GetLong(); + if( nVal <= 65535L ) + StarBASIC::Error( StarBASIC::GetSfxFromVBError( (USHORT) nVal ) ); + } + else + rPar.Get( 0 )->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErr() ) ); +} + +RTLFUNC(False) +{ + rPar.Get(0)->PutBool( FALSE ); +} + +RTLFUNC(Nothing) +{ + // liefert eine leere Objekt-Variable. + rPar.Get( 0 )->PutObject( NULL ); +} + +RTLFUNC(Null) +{ + // liefert eine leere Objekt-Variable. + rPar.Get( 0 )->PutNull(); +} + +RTLFUNC(PI) +{ + rPar.Get( 0 )->PutDouble( F_PI ); +} + +RTLFUNC(True) +{ + rPar.Get( 0 )->PutBool( TRUE ); +} + +RTLFUNC(ATTR_NORMAL) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(ATTR_READONLY) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(ATTR_HIDDEN) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(ATTR_SYSTEM) +{ + rPar.Get(0)->PutInteger(4); +} +RTLFUNC(ATTR_VOLUME) +{ + rPar.Get(0)->PutInteger(8); +} +RTLFUNC(ATTR_DIRECTORY) +{ + rPar.Get(0)->PutInteger(16); +} +RTLFUNC(ATTR_ARCHIVE) +{ + rPar.Get(0)->PutInteger(32); +} + +RTLFUNC(V_EMPTY) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(V_NULL) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(V_INTEGER) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(V_LONG) +{ + rPar.Get(0)->PutInteger(3); +} +RTLFUNC(V_SINGLE) +{ + rPar.Get(0)->PutInteger(4); +} +RTLFUNC(V_DOUBLE) +{ + rPar.Get(0)->PutInteger(5); +} +RTLFUNC(V_CURRENCY) +{ + rPar.Get(0)->PutInteger(6); +} +RTLFUNC(V_DATE) +{ + rPar.Get(0)->PutInteger(7); +} +RTLFUNC(V_STRING) +{ + rPar.Get(0)->PutInteger(8); +} + +RTLFUNC(MB_OK) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(MB_OKCANCEL) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(MB_ABORTRETRYIGNORE) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(MB_YESNOCANCEL) +{ + rPar.Get(0)->PutInteger(3); +} +RTLFUNC(MB_YESNO) +{ + rPar.Get(0)->PutInteger(4); +} +RTLFUNC(MB_RETRYCANCEL) +{ + rPar.Get(0)->PutInteger(5); +} +RTLFUNC(MB_ICONSTOP) +{ + rPar.Get(0)->PutInteger(16); +} +RTLFUNC(MB_ICONQUESTION) +{ + rPar.Get(0)->PutInteger(32); +} +RTLFUNC(MB_ICONEXCLAMATION) +{ + rPar.Get(0)->PutInteger(48); +} +RTLFUNC(MB_ICONINFORMATION) +{ + rPar.Get(0)->PutInteger(64); +} +RTLFUNC(MB_DEFBUTTON1) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(MB_DEFBUTTON2) +{ + rPar.Get(0)->PutInteger(256); +} +RTLFUNC(MB_DEFBUTTON3) +{ + rPar.Get(0)->PutInteger(512); +} +RTLFUNC(MB_APPLMODAL) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(MB_SYSTEMMODAL) +{ + rPar.Get(0)->PutInteger(4096); +} + +RTLFUNC(IDOK) +{ + rPar.Get(0)->PutInteger(1); +} + +RTLFUNC(IDCANCEL) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(IDABORT) +{ + rPar.Get(0)->PutInteger(3); +} +RTLFUNC(IDRETRY) +{ + rPar.Get(0)->PutInteger(4); +} +RTLFUNC(IDYES) +{ + rPar.Get(0)->PutInteger(6); +} +RTLFUNC(IDNO) +{ + rPar.Get(0)->PutInteger(7); +} + +RTLFUNC(CF_TEXT) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(CF_BITMAP) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(CF_METAFILEPICT) +{ + rPar.Get(0)->PutInteger(3); +} + +RTLFUNC(TYP_AUTHORFLD) +{ + rPar.Get(0)->PutInteger(7); +} +RTLFUNC(TYP_CHAPTERFLD) +{ + rPar.Get(0)->PutInteger(4); +} +RTLFUNC(TYP_CONDTXTFLD) +{ + rPar.Get(0)->PutInteger(27); +} +RTLFUNC(TYP_DATEFLD) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(TYP_DBFLD) +{ + rPar.Get(0)->PutInteger(19); +} +RTLFUNC(TYP_DBNAMEFLD) +{ + rPar.Get(0)->PutInteger(3); +} +RTLFUNC(TYP_DBNEXTSETFLD) +{ + rPar.Get(0)->PutInteger(24); +} +RTLFUNC(TYP_DBNUMSETFLD) +{ + rPar.Get(0)->PutInteger(25); +} +RTLFUNC(TYP_DBSETNUMBERFLD) +{ + rPar.Get(0)->PutInteger(26); +} +RTLFUNC(TYP_DDEFLD) +{ + rPar.Get(0)->PutInteger(14); +} +RTLFUNC(TYP_DOCINFOFLD) +{ + rPar.Get(0)->PutInteger(18); +} +RTLFUNC(TYP_DOCSTATFLD) +{ + rPar.Get(0)->PutInteger(6); +} +RTLFUNC(TYP_EXTUSERFLD) +{ + rPar.Get(0)->PutInteger(30); +} +RTLFUNC(TYP_FILENAMEFLD) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(TYP_FIXDATEFLD) +{ + rPar.Get(0)->PutInteger(31); +} +RTLFUNC(TYP_FIXTIMEFLD) +{ + rPar.Get(0)->PutInteger(32); +} +RTLFUNC(TYP_FORMELFLD) +{ + rPar.Get(0)->PutInteger(10); +} +RTLFUNC(TYP_GETFLD) +{ + rPar.Get(0)->PutInteger(9); +} +RTLFUNC(TYP_GETREFFLD) +{ + rPar.Get(0)->PutInteger(13); +} +RTLFUNC(TYP_HIDDENPARAFLD) +{ + rPar.Get(0)->PutInteger(17); +} +RTLFUNC(TYP_HIDDENTXTFLD) +{ + rPar.Get(0)->PutInteger(11); +} +RTLFUNC(TYP_INPUTFLD) +{ + rPar.Get(0)->PutInteger(16); +} +RTLFUNC(TYP_MACROFLD) +{ + rPar.Get(0)->PutInteger(15); +} +RTLFUNC(TYP_NEXTPAGEFLD) +{ + rPar.Get(0)->PutInteger(28); +} +RTLFUNC(TYP_PAGENUMBERFLD) +{ + rPar.Get(0)->PutInteger(5); +} +RTLFUNC(TYP_POSTITFLD) +{ + rPar.Get(0)->PutInteger(21); +} +RTLFUNC(TYP_PREVPAGEFLD) +{ + rPar.Get(0)->PutInteger(29); +} +RTLFUNC(TYP_SEQFLD) +{ + rPar.Get(0)->PutInteger(23); +} +RTLFUNC(TYP_SETFLD) +{ + rPar.Get(0)->PutInteger(8); +} +RTLFUNC(TYP_SETINPFLD) +{ + rPar.Get(0)->PutInteger(33); +} +RTLFUNC(TYP_SETREFFLD) +{ + rPar.Get(0)->PutInteger(12); +} +RTLFUNC(TYP_TEMPLNAMEFLD) +{ + rPar.Get(0)->PutInteger(22); +} +RTLFUNC(TYP_TIMEFLD) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(TYP_USERFLD) +{ + rPar.Get(0)->PutInteger(20); +} +RTLFUNC(TYP_USRINPFLD) +{ + rPar.Get(0)->PutInteger(34); +} +RTLFUNC(TYP_SETREFPAGEFLD) +{ + rPar.Get(0)->PutInteger(35); +} +RTLFUNC(TYP_GETREFPAGEFLD) +{ + rPar.Get(0)->PutInteger(36); +} +RTLFUNC(TYP_INTERNETFLD) +{ + rPar.Get(0)->PutInteger(37); +} + +RTLFUNC(SET_ON) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(SET_OFF) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(TOGGLE) +{ + rPar.Get(0)->PutInteger(2); +} + +RTLFUNC(FRAMEANCHORPAGE) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(FRAMEANCHORPARA) +{ + rPar.Get(0)->PutInteger(14); +} +RTLFUNC(FRAMEANCHORCHAR) +{ + rPar.Get(0)->PutInteger(15); +} + +RTLFUNC(CLEAR_ALLTABS) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(CLEAR_TAB) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(SET_TAB) +{ + rPar.Get(0)->PutInteger(0); +} + +RTLFUNC(LINEPROP) +{ + rPar.Get(0)->PutInteger(0); +} +RTLFUNC(LINE_1) +{ + rPar.Get(0)->PutInteger(1); +} +RTLFUNC(LINE_15) +{ + rPar.Get(0)->PutInteger(2); +} +RTLFUNC(LINE_2) +{ + rPar.Get(0)->PutInteger(3); +} + +RTLFUNC(TYP_JUMPEDITFLD) +{ + rPar.Get(0)->PutInteger(38); +} + + diff --git a/basic/source/runtime/rtlproto.hxx b/basic/source/runtime/rtlproto.hxx new file mode 100644 index 000000000000..18902eafae0e --- /dev/null +++ b/basic/source/runtime/rtlproto.hxx @@ -0,0 +1,354 @@ +/************************************************************************* + * + * $RCSfile: rtlproto.hxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#include "sbstar.hxx" +#include "macfix.hxx" + +#define RTLFUNC( name ) void SbRtl_##name( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite ) +#define RTLNAME( name ) MEMBER(SbRtl_##name) + +typedef void( *RtlCall ) ( StarBASIC* p, SbxArray& rArgs, BOOL bWrite ); + +// Properties + +extern RTLFUNC(Date); +extern RTLFUNC(Err); +extern RTLFUNC(Erl); +extern RTLFUNC(False); +extern RTLFUNC(Nothing); +extern RTLFUNC(Null); +extern RTLFUNC(True); + +extern RTLFUNC(ATTR_NORMAL); +extern RTLFUNC(ATTR_READONLY); +extern RTLFUNC(ATTR_HIDDEN); +extern RTLFUNC(ATTR_SYSTEM); +extern RTLFUNC(ATTR_VOLUME); +extern RTLFUNC(ATTR_DIRECTORY); +extern RTLFUNC(ATTR_ARCHIVE); + +extern RTLFUNC(V_EMPTY); +extern RTLFUNC(V_NULL); +extern RTLFUNC(V_INTEGER); +extern RTLFUNC(V_LONG); +extern RTLFUNC(V_SINGLE); +extern RTLFUNC(V_DOUBLE); +extern RTLFUNC(V_CURRENCY); +extern RTLFUNC(V_DATE); +extern RTLFUNC(V_STRING); + +extern RTLFUNC(MB_OK); +extern RTLFUNC(MB_OKCANCEL); +extern RTLFUNC(MB_ABORTRETRYIGNORE); +extern RTLFUNC(MB_YESNOCANCEL); +extern RTLFUNC(MB_YESNO); +extern RTLFUNC(MB_RETRYCANCEL); +extern RTLFUNC(MB_ICONSTOP); +extern RTLFUNC(MB_ICONQUESTION); +extern RTLFUNC(MB_ICONEXCLAMATION); +extern RTLFUNC(MB_ICONINFORMATION); +extern RTLFUNC(MB_DEFBUTTON1); +extern RTLFUNC(MB_DEFBUTTON2); +extern RTLFUNC(MB_DEFBUTTON3); +extern RTLFUNC(MB_APPLMODAL); +extern RTLFUNC(MB_SYSTEMMODAL); + +extern RTLFUNC(IDOK); +extern RTLFUNC(IDCANCEL); +extern RTLFUNC(IDABORT); +extern RTLFUNC(IDRETRY); +extern RTLFUNC(IDYES); +extern RTLFUNC(IDNO); + +extern RTLFUNC(CF_TEXT); +extern RTLFUNC(CF_BITMAP); +extern RTLFUNC(CF_METAFILEPICT); + +extern RTLFUNC(PI); + +extern RTLFUNC(SET_OFF); +extern RTLFUNC(SET_ON); +extern RTLFUNC(TOGGLE); + +extern RTLFUNC(TYP_AUTHORFLD); +extern RTLFUNC(TYP_CHAPTERFLD); +extern RTLFUNC(TYP_CONDTXTFLD); +extern RTLFUNC(TYP_DATEFLD); +extern RTLFUNC(TYP_DBFLD); +extern RTLFUNC(TYP_DBNAMEFLD); +extern RTLFUNC(TYP_DBNEXTSETFLD); +extern RTLFUNC(TYP_DBNUMSETFLD); +extern RTLFUNC(TYP_DBSETNUMBERFLD); +extern RTLFUNC(TYP_DDEFLD); +extern RTLFUNC(TYP_DOCINFOFLD); +extern RTLFUNC(TYP_DOCSTATFLD); +extern RTLFUNC(TYP_EXTUSERFLD); +extern RTLFUNC(TYP_FILENAMEFLD); +extern RTLFUNC(TYP_FIXDATEFLD); +extern RTLFUNC(TYP_FIXTIMEFLD); +extern RTLFUNC(TYP_FORMELFLD); +extern RTLFUNC(TYP_GETFLD); +extern RTLFUNC(TYP_GETREFFLD); +extern RTLFUNC(TYP_HIDDENPARAFLD); +extern RTLFUNC(TYP_HIDDENTXTFLD); +extern RTLFUNC(TYP_INPUTFLD); +extern RTLFUNC(TYP_MACROFLD); +extern RTLFUNC(TYP_NEXTPAGEFLD); +extern RTLFUNC(TYP_PAGENUMBERFLD); +extern RTLFUNC(TYP_POSTITFLD); +extern RTLFUNC(TYP_PREVPAGEFLD); +extern RTLFUNC(TYP_SEQFLD); +extern RTLFUNC(TYP_SETFLD); +extern RTLFUNC(TYP_SETINPFLD); +extern RTLFUNC(TYP_SETREFFLD); +extern RTLFUNC(TYP_TEMPLNAMEFLD); +extern RTLFUNC(TYP_TIMEFLD); +extern RTLFUNC(TYP_USERFLD); +extern RTLFUNC(TYP_USRINPFLD); +extern RTLFUNC(TYP_SETREFPAGEFLD); +extern RTLFUNC(TYP_GETREFPAGEFLD); +extern RTLFUNC(TYP_INTERNETFLD); +extern RTLFUNC(TYP_JUMPEDITFLD); + +extern RTLFUNC(FRAMEANCHORPAGE); +extern RTLFUNC(FRAMEANCHORPARA); +extern RTLFUNC(FRAMEANCHORCHAR); + +extern RTLFUNC(CLEAR_ALLTABS); +extern RTLFUNC(CLEAR_TAB); +extern RTLFUNC(SET_TAB); + +extern RTLFUNC(LINEPROP); +extern RTLFUNC(LINE_1); +extern RTLFUNC(LINE_15); +extern RTLFUNC(LINE_2); + +// Methoden + +extern RTLFUNC(CreateObject); +extern RTLFUNC(Error); +extern RTLFUNC(Sin); +extern RTLFUNC(Abs); +extern RTLFUNC(Asc); +extern RTLFUNC(Atn); +extern RTLFUNC(Chr); +extern RTLFUNC(Cos); +extern RTLFUNC(CurDir); +extern RTLFUNC(ChDir); // JSM +extern RTLFUNC(ChDrive); // JSM +extern RTLFUNC(FileCopy); // JSM +extern RTLFUNC(Kill); // JSM +extern RTLFUNC(MkDir); // JSM +extern RTLFUNC(RmDir); // JSM +extern RTLFUNC(SendKeys); // JSM +extern RTLFUNC(DimArray); +extern RTLFUNC(Dir); +extern RTLFUNC(Exp); +extern RTLFUNC(FileLen); +extern RTLFUNC(Fix); +extern RTLFUNC(Hex); +extern RTLFUNC(InStr); +extern RTLFUNC(Int); +extern RTLFUNC(LCase); +extern RTLFUNC(Left); +extern RTLFUNC(Log); +extern RTLFUNC(LTrim); +extern RTLFUNC(Mid); +extern RTLFUNC(Oct); +extern RTLFUNC(Right); +extern RTLFUNC(RTrim); +extern RTLFUNC(Sgn); +extern RTLFUNC(Space); +extern RTLFUNC(Sqr); +extern RTLFUNC(Str); +extern RTLFUNC(StrComp); +extern RTLFUNC(String); +extern RTLFUNC(Tan); +extern RTLFUNC(UCase); +extern RTLFUNC(Val); +extern RTLFUNC(Len); +extern RTLFUNC(Spc); +extern RTLFUNC(DateSerial); +extern RTLFUNC(TimeSerial); +extern RTLFUNC(DateValue); +extern RTLFUNC(TimeValue); +extern RTLFUNC(Day); +extern RTLFUNC(Hour); +extern RTLFUNC(Minute); +extern RTLFUNC(Month); +extern RTLFUNC(Now); +extern RTLFUNC(Second); +extern RTLFUNC(Time); +extern RTLFUNC(Timer); +extern RTLFUNC(Weekday); +extern RTLFUNC(Year); +extern RTLFUNC(Date); +extern RTLFUNC(InputBox); +extern RTLFUNC(MsgBox); +extern RTLFUNC(IsArray); +extern RTLFUNC(IsDate); +extern RTLFUNC(IsEmpty); +extern RTLFUNC(IsError); +extern RTLFUNC(IsNull); +extern RTLFUNC(IsNumeric); +extern RTLFUNC(IsObject); +extern RTLFUNC(IsUnoStruct); + +extern RTLFUNC(FileDateTime); +extern RTLFUNC(Format); +extern RTLFUNC(GetAttr); +extern RTLFUNC(Randomize); // JSM +extern RTLFUNC(Rnd); +extern RTLFUNC(Shell); +extern RTLFUNC(VarType); +extern RTLFUNC(TypeName); +extern RTLFUNC(TypeLen); + +extern RTLFUNC(EOF); +extern RTLFUNC(FileAttr); +extern RTLFUNC(Loc); +extern RTLFUNC(Lof); +extern RTLFUNC(Seek); +extern RTLFUNC(SetAttr); // JSM +extern RTLFUNC(Reset); // JSM + +extern RTLFUNC(DDEInitiate); +extern RTLFUNC(DDETerminate); +extern RTLFUNC(DDETerminateAll); +extern RTLFUNC(DDERequest); +extern RTLFUNC(DDEExecute); +extern RTLFUNC(DDEPoke); + +extern RTLFUNC(FreeFile); +extern RTLFUNC(IsMissing); +extern RTLFUNC(LBound); +extern RTLFUNC(UBound); +extern RTLFUNC(RGB); +extern RTLFUNC(QBColor); +extern RTLFUNC(StrConv); + +extern RTLFUNC(Beep); + +extern RTLFUNC(Load); +extern RTLFUNC(Unload); +extern RTLFUNC(AboutStarBasic); +extern RTLFUNC(LoadPicture); +extern RTLFUNC(SavePicture); + +extern RTLFUNC(CBool); // JSM +extern RTLFUNC(CByte); // JSM +extern RTLFUNC(CCur); // JSM +extern RTLFUNC(CDate); // JSM +extern RTLFUNC(CDbl); // JSM +extern RTLFUNC(CInt); // JSM +extern RTLFUNC(CLng); // JSM +extern RTLFUNC(CSng); // JSM +extern RTLFUNC(CStr); // JSM +extern RTLFUNC(CVar); // JSM +extern RTLFUNC(CVErr); // JSM + +extern RTLFUNC(Iif); // JSM + +extern RTLFUNC(DumpAllObjects); + +extern RTLFUNC(GetSystemType); +extern RTLFUNC(GetGUIType); +extern RTLFUNC(Red); +extern RTLFUNC(Green); +extern RTLFUNC(Blue); + +extern RTLFUNC(Switch); +extern RTLFUNC(Wait); +extern RTLFUNC(GetGUIVersion); +extern RTLFUNC(Choose); +extern RTLFUNC(Trim); + +extern RTLFUNC(DateAdd); +extern RTLFUNC(DateDiff); +extern RTLFUNC(DatePart); +extern RTLFUNC(GetSolarVersion); +extern RTLFUNC(TwipsPerPixelX); +extern RTLFUNC(TwipsPerPixelY); +extern RTLFUNC(FreeLibrary); +extern RTLFUNC(Array); +extern RTLFUNC(FindObject); +extern RTLFUNC(FindPropertyObject); +extern RTLFUNC(EnableReschedule); + +extern RTLFUNC(Put); +extern RTLFUNC(Get); +extern RTLFUNC(Environ); +extern RTLFUNC(GetDialogZoomFactorX); +extern RTLFUNC(GetDialogZoomFactorY); +extern RTLFUNC(GetSystemTicks); +extern RTLFUNC(GetPathSeparator); +extern RTLFUNC(ResolvePath); +extern RTLFUNC(CreateUnoStruct); +extern RTLFUNC(CreateUnoService); +extern RTLFUNC(GetProcessServiceManager); +extern RTLFUNC(CreatePropertySet); +extern RTLFUNC(CreateUnoListener); +extern RTLFUNC(HasUnoInterfaces); +extern RTLFUNC(EqualUnoObjects); + +extern RTLFUNC(FileExists); + + diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx new file mode 100644 index 000000000000..587c59ffeb9e --- /dev/null +++ b/basic/source/runtime/runtime.cxx @@ -0,0 +1,934 @@ +/************************************************************************* + * + * $RCSfile: runtime.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _FSYS_HXX //autogen +#include <tools/fsys.hxx> +#endif +#ifndef _SV_SVAPP_HXX //autogen +#include <vcl/svapp.hxx> +#endif +#ifndef _INTN_HXX //autogen +#include <tools/intn.hxx> +#endif + +#ifndef _ZFORLIST_HXX //autogen +#include <svtools/zforlist.hxx> +#endif +#include <svtools/sbx.hxx> +#include "runtime.hxx" +#pragma hdrstop +#include "sbintern.hxx" +#include "opcodes.hxx" +#include "iosys.hxx" +#include "image.hxx" +#include "ddectrl.hxx" +#include "dllmgr.hxx" + +// Makro MEMBER() +#include <macfix.hxx> + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +struct SbiGosubStack { // GOSUB-Stack: + SbiGosubStack* pNext; // Chain + const BYTE* pCode; // Return-Pointer +}; + +struct SbiArgvStack { // Argv stack: + SbiArgvStack* pNext; // Stack Chain + SbxArrayRef refArgv; // Argv + short nArgc; // Argc +}; + +SbiRuntime::pStep0 SbiRuntime::aStep0[] = { // Alle Opcodes ohne Operanden + MEMBER(SbiRuntime::StepNOP), + MEMBER(SbiRuntime::StepEXP), + MEMBER(SbiRuntime::StepMUL), + MEMBER(SbiRuntime::StepDIV), + MEMBER(SbiRuntime::StepMOD), + MEMBER(SbiRuntime::StepPLUS), + MEMBER(SbiRuntime::StepMINUS), + MEMBER(SbiRuntime::StepNEG), + MEMBER(SbiRuntime::StepEQ), + MEMBER(SbiRuntime::StepNE), + MEMBER(SbiRuntime::StepLT), + MEMBER(SbiRuntime::StepGT), + MEMBER(SbiRuntime::StepLE), + MEMBER(SbiRuntime::StepGE), + MEMBER(SbiRuntime::StepIDIV), + MEMBER(SbiRuntime::StepAND), + MEMBER(SbiRuntime::StepOR), + MEMBER(SbiRuntime::StepXOR), + MEMBER(SbiRuntime::StepEQV), + MEMBER(SbiRuntime::StepIMP), + MEMBER(SbiRuntime::StepNOT), + MEMBER(SbiRuntime::StepCAT), + + MEMBER(SbiRuntime::StepLIKE), + MEMBER(SbiRuntime::StepIS), + // Laden/speichern + MEMBER(SbiRuntime::StepARGC), // neuen Argv einrichten + MEMBER(SbiRuntime::StepARGV), // TOS ==> aktueller Argv + MEMBER(SbiRuntime::StepINPUT), // Input ==> TOS + MEMBER(SbiRuntime::StepLINPUT), // Line Input ==> TOS + MEMBER(SbiRuntime::StepGET), // TOS anfassen + MEMBER(SbiRuntime::StepSET), // Speichern Objekt TOS ==> TOS-1 + MEMBER(SbiRuntime::StepPUT), // TOS ==> TOS-1 + MEMBER(SbiRuntime::StepPUTC), // TOS ==> TOS-1, dann ReadOnly + MEMBER(SbiRuntime::StepDIM), // DIM + MEMBER(SbiRuntime::StepREDIM), // REDIM + MEMBER(SbiRuntime::StepREDIMP), // REDIM PRESERVE + MEMBER(SbiRuntime::StepERASE), // TOS loeschen + // Verzweigen + MEMBER(SbiRuntime::StepSTOP), // Programmende + MEMBER(SbiRuntime::StepINITFOR), // FOR-Variable initialisieren + MEMBER(SbiRuntime::StepNEXT), // FOR-Variable inkrementieren + MEMBER(SbiRuntime::StepCASE), // Anfang CASE + MEMBER(SbiRuntime::StepENDCASE), // Ende CASE + MEMBER(SbiRuntime::StepSTDERROR), // Standard-Fehlerbehandlung + MEMBER(SbiRuntime::StepNOERROR), // keine Fehlerbehandlung + MEMBER(SbiRuntime::StepLEAVE), // UP verlassen + // E/A + MEMBER(SbiRuntime::StepCHANNEL), // TOS = Kanalnummer + MEMBER(SbiRuntime::StepPRINT), // print TOS + MEMBER(SbiRuntime::StepPRINTF), // print TOS in field + MEMBER(SbiRuntime::StepWRITE), // write TOS + MEMBER(SbiRuntime::StepRENAME), // Rename Tos+1 to Tos + MEMBER(SbiRuntime::StepPROMPT), // Input Prompt aus TOS definieren + MEMBER(SbiRuntime::StepRESTART), // Set restart point + MEMBER(SbiRuntime::StepCHANNEL0), // E/A-Kanal 0 einstellen + MEMBER(SbiRuntime::StepEMPTY), // Leeren Ausdruck auf Stack + MEMBER(SbiRuntime::StepERROR), // TOS = Fehlercode + MEMBER(SbiRuntime::StepLSET), // Speichern Objekt TOS ==> TOS-1 + MEMBER(SbiRuntime::StepRSET) // Speichern Objekt TOS ==> TOS-1 +}; + +SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // Alle Opcodes mit einem Operanden + MEMBER(SbiRuntime::StepLOADNC), // Laden einer numerischen Konstanten (+ID) + MEMBER(SbiRuntime::StepLOADSC), // Laden einer Stringkonstanten (+ID) + MEMBER(SbiRuntime::StepLOADI), // Immediate Load (+Wert) + MEMBER(SbiRuntime::StepARGN), // Speichern eines named Args in Argv (+StringID) + MEMBER(SbiRuntime::StepPAD), // String auf feste Laenge bringen (+Laenge) + // Verzweigungen + MEMBER(SbiRuntime::StepJUMP), // Sprung (+Target) + MEMBER(SbiRuntime::StepJUMPT), // TOS auswerten), bedingter Sprung (+Target) + MEMBER(SbiRuntime::StepJUMPF), // TOS auswerten), bedingter Sprung (+Target) + MEMBER(SbiRuntime::StepONJUMP), // TOS auswerten), Sprung in JUMP-Tabelle (+MaxVal) + MEMBER(SbiRuntime::StepGOSUB), // UP-Aufruf (+Target) + MEMBER(SbiRuntime::StepRETURN), // UP-Return (+0 oder Target) + MEMBER(SbiRuntime::StepTESTFOR), // FOR-Variable testen), inkrementieren (+Endlabel) + MEMBER(SbiRuntime::StepCASETO), // Tos+1 <= Case <= Tos), 2xremove (+Target) + MEMBER(SbiRuntime::StepERRHDL), // Fehler-Handler (+Offset) + MEMBER(SbiRuntime::StepRESUME), // Resume nach Fehlern (+0 or 1 or Label) + // E/A + MEMBER(SbiRuntime::StepCLOSE), // (+Kanal/0) + MEMBER(SbiRuntime::StepPRCHAR), // (+char) + // Verwaltung + MEMBER(SbiRuntime::StepCLASS), // Klassennamen testen (+StringId) + MEMBER(SbiRuntime::StepLIB), // Lib fuer Declare-Call (+StringId) + MEMBER(SbiRuntime::StepBASED), // TOS wird um BASE erhoeht, BASE davor gepusht + MEMBER(SbiRuntime::StepARGTYP), // Letzten Parameter in Argv konvertieren (+Typ) +}; + +SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// Alle Opcodes mit zwei Operanden + MEMBER(SbiRuntime::StepRTL), // Laden aus RTL (+StringID+Typ) + MEMBER(SbiRuntime::StepFIND), // Laden (+StringID+Typ) + MEMBER(SbiRuntime::StepELEM), // Laden Element (+StringID+Typ) + MEMBER(SbiRuntime::StepPARAM), // Parameter (+Offset+Typ) + // Verzweigen + MEMBER(SbiRuntime::StepCALL), // Declare-Call (+StringID+Typ) + MEMBER(SbiRuntime::StepCALLC), // CDecl-Declare-Call (+StringID+Typ) + MEMBER(SbiRuntime::StepCASEIS), // Case-Test (+Test-Opcode+False-Target) + // Verwaltung + MEMBER(SbiRuntime::StepSTMNT), // Beginn eines Statements (+Line+Col) + // E/A + MEMBER(SbiRuntime::StepOPEN), // (+SvStreamFlags+Flags) + // Objekte + MEMBER(SbiRuntime::StepLOCAL), // Lokale Variable definieren (+StringId+Typ) + MEMBER(SbiRuntime::StepPUBLIC), // Modulglobale Variable (+StringID+Typ) + MEMBER(SbiRuntime::StepGLOBAL), // Globale Variable definieren (+StringID+Typ) + MEMBER(SbiRuntime::StepCREATE), // Objekt kreieren (+StringId+StringId) + MEMBER(SbiRuntime::StepSTATIC), // Statische Variable (+StringId+StringId) + MEMBER(SbiRuntime::StepTCREATE), // User Defined Objekte (+StringId+StringId) + MEMBER(SbiRuntime::StepDCREATE), // Objekt-Array kreieren (+StringID+StringID) +}; + +////////////////////////////////////////////////////////////////////////// +// SbiRTLData // +////////////////////////////////////////////////////////////////////////// + +SbiRTLData::SbiRTLData() +{ + pDir = 0; + nDirFlags = 0; + nCurDirPos = 0; +} + +SbiRTLData::~SbiRTLData() +{ + delete pDir; + pDir = 0; +} + +////////////////////////////////////////////////////////////////////////// +// SbiInstance // +////////////////////////////////////////////////////////////////////////// + +// 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out +// Die Entscheidung, ob StepPoint aufgerufen werden soll, wird anhand des +// CallLevels getroffen. Angehalten wird, wenn der aktuelle CallLevel <= +// nBreakCallLvl ist. Der aktuelle CallLevel kann niemals kleiner als 1 +// sein, da er beim Aufruf einer Methode (auch main) inkrementiert wird. +// Daher bedeutet ein BreakCallLvl von 0, dass das Programm gar nicht +// angehalten wird. +// (siehe auch step2.cxx, SbiRuntime::StepSTMNT() ) + +// Hilfsfunktion, um den BreakCallLevel gemaess der der Debug-Flags zu ermitteln +void SbiInstance::CalcBreakCallLevel( USHORT nFlags ) +{ + // Break-Flag wegfiltern + nFlags &= ~((USHORT)SbDEBUG_BREAK); + + USHORT nRet; + switch( nFlags ) + { + case SbDEBUG_STEPINTO: + nRet = nCallLvl + 1; // CallLevel+1 wird auch angehalten + break; + case SbDEBUG_STEPOVER | SbDEBUG_STEPINTO: + nRet = nCallLvl; // Aktueller CallLevel wird angehalten + break; + case SbDEBUG_STEPOUT: + nRet = nCallLvl - 1; // Kleinerer CallLevel wird angehalten + break; + case SbDEBUG_CONTINUE: + // Basic-IDE liefert 0 statt SbDEBUG_CONTINUE, also auch default=continue + default: + nRet = 0; // CallLevel ist immer >0 -> kein StepPoint + } + nBreakCallLvl = nRet; // Ergebnis uebernehmen +} + +SbiInstance::SbiInstance( StarBASIC* p ) +{ + pBasic = p; + pNext = NULL; + pRun = NULL; + pIosys = new SbiIoSystem; + pDdeCtrl = new SbiDdeControl; + pDllMgr = 0; // on demand + pNumberFormatter = 0; // on demand + nCallLvl = 0; + nBreakCallLvl = 0; + nErr = + nErl = 0; + bReschedule = TRUE; +} + +SbiInstance::~SbiInstance() +{ + while( pRun ) + { + SbiRuntime* p = pRun->pNext; + delete pRun; + pRun = p; + } + delete pIosys; + delete pDdeCtrl; + delete pDllMgr; + delete pNumberFormatter; +} + +SbiDllMgr* SbiInstance::GetDllMgr() +{ + if( !pDllMgr ) + pDllMgr = new SbiDllMgr; + return pDllMgr; +} + +// #39629 NumberFormatter jetzt ueber statische Methode anlegen +SvNumberFormatter* SbiInstance::GetNumberFormatter() +{ + if( !pNumberFormatter ) + PrepareNumberFormatter( pNumberFormatter, nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx ); + return pNumberFormatter; +} + +// #39629 NumberFormatter auch statisch anbieten +void SbiInstance::PrepareNumberFormatter( SvNumberFormatter*& rpNumberFormatter, + ULONG &rnStdDateIdx, ULONG &rnStdTimeIdx, ULONG &rnStdDateTimeIdx ) +{ + const International& rInter = GetpApp()->GetAppInternational(); + LanguageType eLangType = rInter.GetLanguage(); + rpNumberFormatter = new SvNumberFormatter( eLangType ); + xub_StrLen nCheckPos = 0; short nType; + rnStdTimeIdx = rpNumberFormatter->GetStandardFormat( NUMBERFORMAT_TIME, eLangType ); + + // Standard-Vorlagen des Formatters haben nur zweistellige + // Jahreszahl. Deshalb eigenes Format registrieren + + // HACK, da der Numberformatter in PutandConvertEntry die Platzhalter + // fuer Monat, Tag, Jahr nicht entsprechend der Systemeinstellung + // austauscht. Problem: Print Year(Date) unter engl. BS + // siehe auch svtools\source\sbx\sbxdate.cxx + + DateFormat eDate = rInter.GetDateFormat(); + String aDateStr; + switch( eDate ) + { + case MDY: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") ); break; + case DMY: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("TT.MM.JJJJ") ); break; + case YMD: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("JJJJ.MM.TT") ); break; + default: aDateStr = String( RTL_CONSTASCII_USTRINGPARAM("MM.TT.JJJJ") ); + } + String aStr( aDateStr ); + rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType, + rnStdDateIdx, LANGUAGE_GERMAN, eLangType ); + nCheckPos = 0; + String aStrHHMMSS( RTL_CONSTASCII_USTRINGPARAM(" HH:MM:SS") ); + aStr = aDateStr; + aStr += aStrHHMMSS; + rpNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType, + rnStdDateTimeIdx, LANGUAGE_GERMAN, eLangType ); +} + + + +// Engine laufenlassen. Falls Flags == SbDEBUG_CONTINUE, Flags uebernehmen + +void SbiInstance::Stop() +{ + for( SbiRuntime* p = pRun; p; p = p->pNext ) + p->Stop(); +} + +void SbiInstance::Error( SbError n ) +{ + Error( n, String() ); +} + +void SbiInstance::Error( SbError n, const String& rMsg ) +{ + aErrorMsg = rMsg; + pRun->Error( n ); +} + +void SbiInstance::FatalError( SbError n ) +{ + pRun->FatalError( n ); +} + +void SbiInstance::Abort() +{ + // Basic suchen, in dem der Fehler auftrat + StarBASIC* pErrBasic = GetCurrentBasic( pBasic ); + pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 ); + pBasic->Stop(); +} + +// Hilfsfunktion, um aktives Basic zu finden, kann ungleich pRTBasic sein +StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic ) +{ + StarBASIC* pCurBasic = pRTBasic; + SbModule* pActiveModule = pRTBasic->GetActiveModule(); + if( pActiveModule ) + { + SbxObject* pParent = pActiveModule->GetParent(); + if( pParent && pParent->ISA(StarBASIC) ) + pCurBasic = (StarBASIC*)pParent; + } + return pCurBasic; +} + +SbModule* SbiInstance::GetActiveModule() +{ + if( pRun ) + return pRun->GetModule(); + else + return NULL; +} + +SbMethod* SbiInstance::GetCaller( USHORT nLevel ) +{ + SbiRuntime* p = pRun; + while( nLevel-- && p ) + p = p->pNext; + if( p ) + return p->GetCaller(); + else + return NULL; +} + +SbxArray* SbiInstance::GetLocals( SbMethod* pMeth ) +{ + SbiRuntime* p = pRun; + while( p && p->GetMethod() != pMeth ) + p = p->pNext; + if( p ) + return p->GetLocals(); + else + return NULL; +} + +////////////////////////////////////////////////////////////////////////// +// SbiInstance // +////////////////////////////////////////////////////////////////////////// + +// Achtung: pMeth kann auch NULL sein (beim Aufruf des Init-Codes) + +SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, USHORT nStart ) + : pMeth( pe ), pMod( pm ), pImg( pMod->pImage ), + rBasic( *(StarBASIC*)pm->pParent ), pInst( pINST ) +{ + nFlags = pe ? pe->GetDebugFlags() : 0; + pIosys = pInst->pIosys; + pArgvStk = NULL; + pGosubStk = NULL; + pForStk = NULL; + pError = NULL; + pErrCode = + pErrStmnt = + pRestart = NULL; + pNext = NULL; + pCode = + pStmnt = (const BYTE* ) pImg->GetCode() + nStart; + bRun = + bError = TRUE; + bInError = FALSE; + nLine = + nCol1 = + nCol2 = + nExprLvl = + nArgc = + nError = + nGosubLvl = + nOps = 0; + refExprStk = new SbxArray; +#if defined GCC + SetParameters( pe ? pe->GetParameters() : (class SbxArray *)NULL ); +#else + SetParameters( pe ? pe->GetParameters() : NULL ); +#endif + pRefSaveList = NULL; + pItemStoreList = NULL; +} + +SbiRuntime::~SbiRuntime() +{ + ClearGosubStack(); + ClearArgvStack(); + ClearForStack(); + + // #74254 Items zum Sichern temporaere Referenzen freigeben + ClearRefs(); + while( pItemStoreList ) + { + RefSaveItem* pToDeleteItem = pItemStoreList; + pItemStoreList = pToDeleteItem->pNext; + delete pToDeleteItem; + } +} + +// Aufbau der Parameterliste. Alle ByRef-Parameter werden direkt +// uebernommen; von ByVal-Parametern werden Kopien angelegt. Falls +// ein bestimmter Datentyp verlangt wird, wird konvertiert. + +void SbiRuntime::SetParameters( SbxArray* pParams ) +{ + refParams = new SbxArray; + // fuer den Returnwert + refParams->Put( pMeth, 0 ); + if( pParams ) + { + SbxInfo* pInfo = pMeth->GetInfo(); + for( USHORT i = 1; i < pParams->Count(); i++ ) + { + const SbxParamInfo* p = pInfo ? pInfo->GetParam( i ) : NULL; + SbxVariable* v = pParams->Get( i ); + // Methoden sind immer byval! + BOOL bByVal = v->IsA( TYPE(SbxMethod) ); + SbxDataType t = v->GetType(); + if( p ) + { + bByVal |= BOOL( ( p->eType & SbxBYREF ) == 0 ); + t = (SbxDataType) ( p->eType & 0x0FFF ); + } + if( bByVal ) + { + SbxVariable* v2 = new SbxVariable( t ); + v2->SetFlag( SBX_READWRITE ); + *v2 = *v; + refParams->Put( v2, i ); + } + else + { + if( t != SbxVARIANT && t != ( v->GetType() & 0x0FFF ) ) + { + // Array konvertieren?? + if( p && (p->eType & SbxARRAY) ) + Error( SbERR_CONVERSION ); + else + v->Convert( t ); + } + refParams->Put( v, i ); + } + if( p ) + refParams->PutAlias( p->aName, i ); + } + } +} + +// Einen P-Code ausfuehren + +BOOL SbiRuntime::Step() +{ + if( bRun ) + { + // Unbedingt gelegentlich die Kontrolle abgeben! + if( pInst->IsReschedule() && !( ++nOps & 0x1F ) ) + Application::Reschedule(); + + SbiOpcode eOp = (SbiOpcode ) ( *pCode++ ); + USHORT nOp1, nOp2; + if( eOp <= SbOP0_END ) + { + (this->*( aStep0[ eOp ] ) )(); + } + else if( eOp >= SbOP1_START && eOp <= SbOP1_END ) + { + nOp1 = *pCode++; nOp1 |= *pCode++ << 8; + (this->*( aStep1[ eOp - SbOP1_START ] ) )( nOp1 ); + } + else if( eOp >= SbOP2_START && eOp <= SbOP2_END ) + { + nOp1 = *pCode++; nOp1 |= *pCode++ << 8; + nOp2 = *pCode++; nOp2 |= *pCode++ << 8; + (this->*( aStep2[ eOp - SbOP2_START ] ) )( nOp1, nOp2 ); + } + else + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + + // SBX-Fehler aufgetreten? + SbError nSbError = SbxBase::GetError(); + Error( ERRCODE_TOERROR(nSbError) ); // Warnings rausfiltern + + // AB 13.2.1997, neues Error-Handling: + // ACHTUNG: Hier kann nError auch dann gesetzt sein, wenn !nSbError, + // da nError jetzt auch von anderen RT-Instanzen gesetzt werden kann + + if( nError ) + SbxBase::ResetError(); + + // AB,15.3.96: Fehler nur anzeigen, wenn BASIC noch aktiv + // (insbesondere nicht nach Compiler-Fehlern zur Laufzeit) + if( nError && bRun ) + { + SbError err = nError; + ClearExprStack(); + nError = 0; + // Im Error Handler? Dann Std-Error + if( bInError ) + { + StepSTDERROR(); + pInst->Abort(); + } + else + { + bInError = TRUE; + + pInst->nErr = err; + pInst->nErl = nLine; + pErrCode = pCode; + pErrStmnt = pStmnt; + if( !bError ) // On Error Resume Next + StepRESUME( 1 ); + else if( pError ) // On Error Goto ... + pCode = pError; + else // Standard-Fehlerbehandlung + { + // AB 13.2.1997, neues Error-Handling: + // Uebergeordnete Error-Handler beruecksichtigen + + // Wir haben keinen Error-Handler -> weiter oben suchen + SbiRuntime* pRtErrHdl = NULL; + SbiRuntime* pRt = this; + while( NULL != (pRt = pRt->pNext) ) + { + // Gibt es einen Error-Handler? + if( pRt->bError == FALSE || pRt->pError != NULL ) + { + pRtErrHdl = pRt; + break; + } + } + + // Error-Hdl gefunden? + if( pRtErrHdl ) + { + // (Neuen) Error-Stack anlegen + SbErrorStack*& rErrStack = GetSbData()->pErrStack; + if( rErrStack ) + delete rErrStack; + rErrStack = new SbErrorStack(); + + // Alle im Call-Stack darunter stehenden RTs manipulieren + pRt = this; + do + { + // Fehler setzen + pRt->nError = err; + if( pRt != pRtErrHdl ) + pRt->bRun = FALSE; + + // In Error-Stack eintragen + SbErrorStackEntry *pEntry = new SbErrorStackEntry + ( pRt->pMeth, pRt->nLine, pRt->nCol1, pRt->nCol2 ); + rErrStack->C40_INSERT(SbErrorStackEntry, pEntry, rErrStack->Count() ); + + // Nach RT mit Error-Handler aufhoeren + if( pRt == pRtErrHdl ) + break; + } + while( pRt = pRt->pNext ); + } + // Kein Error-Hdl gefunden -> altes Vorgehen + else + { + pInst->Abort(); + } + + // ALT: Nur + // pInst->Abort(); + } + } + } + } + return bRun; +} + +void SbiRuntime::Error( SbError n ) +{ + if( n ) + nError = n; +} + +void SbiRuntime::FatalError( SbError n ) +{ + StepSTDERROR(); + Error( n ); +} + +////////////////////////////////////////////////////////////////////////// +// +// Parameter, Locals, Caller +// +////////////////////////////////////////////////////////////////////////// + +SbMethod* SbiRuntime::GetCaller() +{ + return pMeth; +} + +SbxArray* SbiRuntime::GetLocals() +{ + return refLocals; +} + +SbxArray* SbiRuntime::GetParams() +{ + return refParams; +} + +////////////////////////////////////////////////////////////////////////// +// +// Stacks +// +////////////////////////////////////////////////////////////////////////// + +// Der Expression-Stack steht fuer die laufende Auswertung von Expressions +// zur Verfuegung. + +void SbiRuntime::PushVar( SbxVariable* pVar ) +{ + if( pVar ) + refExprStk->Put( pVar, nExprLvl++ ); +} + +SbxVariableRef SbiRuntime::PopVar() +{ +#ifndef PRODUCT + if( !nExprLvl ) + { + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + return new SbxVariable; + } +#endif + SbxVariableRef xVar = refExprStk->Get( --nExprLvl ); +#ifdef DBG_UTIL + if ( xVar->GetName().EqualsAscii( "Cells" ) ) + DBG_TRACE( "" ); +#endif + // Methods halten im 0.Parameter sich selbst, also weghauen + if( xVar->IsA( TYPE(SbxMethod) ) ) + xVar->SetParameters(0); + return xVar; +} + +BOOL SbiRuntime::ClearExprStack() +{ + // #74732 Hier kann ein Fehler gesetzt werden + BOOL bErrorSet = FALSE; + + // Achtung: Clear() reicht nicht, da Methods geloescht werden muessen + while ( nExprLvl ) + { + SbxVariableRef xVar = PopVar(); + if( !nError && xVar->ISA( UnoClassMemberVariable ) ) + { + Error( SbERR_NO_METHOD ); + bErrorSet = TRUE; + } + } + refExprStk->Clear(); + return bErrorSet; +} + +// Variable auf dem Expression-Stack holen, ohne sie zu entfernen +// n zaehlt ab 0. + +SbxVariable* SbiRuntime::GetTOS( short n ) +{ + n = nExprLvl - n - 1; +#ifndef PRODUCT + if( n < 0 ) + { + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + return new SbxVariable; + } +#endif + return refExprStk->Get( (USHORT) n ); +} + +// Sicherstellen, dass TOS eine temporaere Variable ist + +void SbiRuntime::TOSMakeTemp() +{ + SbxVariable* p = refExprStk->Get( nExprLvl - 1 ); + if( p->GetRefCount() != 1 ) + { + // #74573 UnoClassSbxVariable spezialbehandeln + SbxVariable* pNew; + if( p->ISA( UnoClassSbxVariable ) ) + pNew = new UnoClassSbxVariable( *(UnoClassSbxVariable*)p ); + else + pNew = new SbxVariable( *p ); + pNew->SetFlag( SBX_READWRITE ); + refExprStk->Put( pNew, nExprLvl - 1 ); + } +} + +// Der GOSUB-Stack nimmt Returnadressen fuer GOSUBs auf + +void SbiRuntime::PushGosub( const BYTE* pc ) +{ + if( ++nGosubLvl > MAXRECURSION ) + StarBASIC::FatalError( SbERR_STACK_OVERFLOW ); + SbiGosubStack* p = new SbiGosubStack; + p->pCode = pc; + p->pNext = pGosubStk; + pGosubStk = p; +} + +void SbiRuntime::PopGosub() +{ + if( !pGosubStk ) + Error( SbERR_NO_GOSUB ); + else + { + SbiGosubStack* p = pGosubStk; + pCode = p->pCode; + pGosubStk = p->pNext; + delete p; + nGosubLvl--; + } +} + +// Entleeren des GOSUB-Stacks + +void SbiRuntime::ClearGosubStack() +{ + SbiGosubStack* p; + while(( p = pGosubStk ) != NULL ) + pGosubStk = p->pNext, delete p; + nGosubLvl = 0; +} + +// Der Argv-Stack nimmt aktuelle Argument-Vektoren auf + +void SbiRuntime::PushArgv() +{ + SbiArgvStack* p = new SbiArgvStack; + p->refArgv = refArgv; + p->nArgc = nArgc; + nArgc = 1; + refArgv.Clear(); + p->pNext = pArgvStk; + pArgvStk = p; +} + +void SbiRuntime::PopArgv() +{ + if( pArgvStk ) + { + SbiArgvStack* p = pArgvStk; + pArgvStk = p->pNext; + refArgv = p->refArgv; + nArgc = p->nArgc; + delete p; + } +} + +// Entleeren des Argv-Stacks + +void SbiRuntime::ClearArgvStack() +{ + while( pArgvStk ) + PopArgv(); +} + +// Push des For-Stacks. Der Stack hat Inkrement, Ende, Beginn und Variable. +// Nach Aufbau des Stack-Elements ist der Stack leer. + +void SbiRuntime::PushFor() +{ + SbiForStack* p = new SbiForStack; + p->pNext = pForStk; + pForStk = p; + // Der Stack ist wie folgt aufgebaut: + p->refInc = PopVar(); + p->refEnd = PopVar(); + SbxVariableRef xBgn = PopVar(); + p->refVar = PopVar(); + *(p->refVar) = *xBgn; +} + +// Poppen des FOR-Stacks + +void SbiRuntime::PopFor() +{ + if( pForStk ) + { + SbiForStack* p = pForStk; + pForStk = p->pNext; + delete p; + } +} + +// Entleeren des FOR-Stacks + +void SbiRuntime::ClearForStack() +{ + while( pForStk ) + PopFor(); +} + +////////////////////////////////////////////////////////////////////////// +// +// DLL-Aufrufe +// +////////////////////////////////////////////////////////////////////////// + +void SbiRuntime::DllCall + ( const String& aFuncName, // Funktionsname + const String& aDLLName, // Name der DLL + SbxArray* pArgs, // Parameter (ab Index 1, kann NULL sein) + SbxDataType eResType, // Returnwert + BOOL bCDecl ) // TRUE: nach C-Konventionen +{ + // No DllCall for "virtual" portal users + if( needSecurityRestrictions() ) + { + StarBASIC::Error(SbERR_NOT_IMPLEMENTED); + return; + } + + // MUSS NOCH IMPLEMENTIERT WERDEN + /* + String aMsg; + aMsg = "FUNC="; + aMsg += pFunc; + aMsg += " DLL="; + aMsg += pDLL; + MessBox( NULL, WB_OK, String( "DLL-CALL" ), aMsg ).Execute(); + Error( SbERR_NOT_IMPLEMENTED ); + */ + + SbxVariable* pRes = new SbxVariable( eResType ); + SbiDllMgr* pDllMgr = pInst->GetDllMgr(); + ByteString aByteFuncName( aFuncName, gsl_getSystemTextEncoding() ); + ByteString aByteDLLName( aDLLName, gsl_getSystemTextEncoding() ); + SbError nErr = pDllMgr->Call( aByteFuncName.GetBuffer(), aByteDLLName.GetBuffer(), pArgs, *pRes, bCDecl ); + if( nErr ) + Error( nErr ); + PushVar( pRes ); +} + diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx new file mode 100644 index 000000000000..778d5d727440 --- /dev/null +++ b/basic/source/runtime/stdobj.cxx @@ -0,0 +1,729 @@ +/************************************************************************* + * + * $RCSfile: stdobj.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _SBXCLASS_HXX //autogen +#include <svtools/sbx.hxx> +#endif +#include "runtime.hxx" +#pragma hdrstop +#include "stdobj.hxx" +#include "stdobj1.hxx" +#include "rtlproto.hxx" + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +// Das nArgs-Feld eines Tabelleneintrags ist wie folgt verschluesselt: +// Zur Zeit wird davon ausgegangen, dass Properties keine Parameter +// benoetigen! + +#define _ARGSMASK 0x00FF // Bis zu 255 Argumente +#define _RWMASK 0x0F00 // Maske fuer R/W-Bits +#define _TYPEMASK 0xF000 // Maske fuer den Typ des Eintrags + +#define _READ 0x0100 // kann gelesen werden +#define _BWRITE 0x0200 // kann as Lvalue verwendet werden +#define _LVALUE _BWRITE // kann as Lvalue verwendet werden +#define _READWRITE 0x0300 // beides +#define _OPT 0x0400 // Parameter ist optional +#define _CONST 0x0800 // Property ist const +#define _METHOD 0x3000 // Masken-Bits fuer eine Methode +#define _PROPERTY 0x4000 // Masken-Bit fuer eine Property +#define _OBJECT 0x8000 // Masken-Bit fuer ein Objekt + // Kombination von oberen Bits: +#define _FUNCTION 0x1100 // Maske fuer Function +#define _LFUNCTION 0x1300 // Maske fuer Function, die auch als Lvalue geht +#define _SUB 0x2100 // Maske fuer Sub +#define _ROPROP 0x4100 // Maske Read Only-Property +#define _WOPROP 0x4200 // Maske Write Only-Property +#define _RWPROP 0x4300 // Maske Read/Write-Property +#define _CPROP 0x4900 // Maske fuer Konstante + +struct Methods { + const char* pName; // Name des Eintrags + SbxDataType eType; // Datentyp + short nArgs; // Argumente und Flags + RtlCall pFunc; // Function Pointer + USHORT nHash; // Hashcode +}; + +static Methods aMethods[] = { + +{ "AboutStarBasic", SbxNULL, 1 | _FUNCTION, RTLNAME(AboutStarBasic) }, + { "Name", SbxSTRING }, +{ "Abs", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Abs) }, + { "number", SbxDOUBLE }, +{ "Array", SbxOBJECT, _FUNCTION, RTLNAME(Array) }, +{ "Asc", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Asc) }, + { "string", SbxSTRING }, +{ "Atn", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Atn) }, + { "number", SbxDOUBLE }, +{ "ATTR_ARCHIVE", SbxINTEGER, _CPROP, RTLNAME(ATTR_ARCHIVE) }, +{ "ATTR_DIRECTORY", SbxINTEGER, _CPROP, RTLNAME(ATTR_DIRECTORY) }, +{ "ATTR_HIDDEN", SbxINTEGER, _CPROP, RTLNAME(ATTR_HIDDEN) }, +{ "ATTR_NORMAL", SbxINTEGER, _CPROP, RTLNAME(ATTR_NORMAL) }, +{ "ATTR_READONLY", SbxINTEGER, _CPROP, RTLNAME(ATTR_READONLY) }, +{ "ATTR_SYSTEM", SbxINTEGER, _CPROP, RTLNAME(ATTR_SYSTEM) }, +{ "ATTR_VOLUME", SbxINTEGER, _CPROP, RTLNAME(ATTR_VOLUME) }, +{ "Beep", SbxNULL, _FUNCTION, RTLNAME(Beep) }, +{ "Blue", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Blue) }, + { "RGB-Value", SbxLONG }, + +{ "CBool", SbxBOOL, 1 | _FUNCTION, RTLNAME(CBool) }, + { "expression", SbxVARIANT }, +{ "CByte", SbxBYTE, 1 | _FUNCTION, RTLNAME(CByte) }, + { "expression", SbxVARIANT }, +{ "CCur", SbxCURRENCY, 1 | _FUNCTION, RTLNAME(CCur) }, + { "expression", SbxVARIANT }, +{ "CDate", SbxDATE, 1 | _FUNCTION, RTLNAME(CDate) }, + { "expression", SbxVARIANT }, +{ "CDbl", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(CDbl) }, + { "expression", SbxVARIANT }, +{ "CF_BITMAP", SbxINTEGER, _CPROP, RTLNAME(CF_BITMAP) }, +{ "CF_METAFILEPICT",SbxINTEGER, _CPROP, RTLNAME(CF_METAFILEPICT) }, +{ "CF_TEXT", SbxINTEGER, _CPROP, RTLNAME(CF_TEXT) }, +{ "ChDir", SbxNULL, 1 | _FUNCTION, RTLNAME(ChDir) }, + { "string", SbxSTRING }, +{ "ChDrive", SbxNULL, 1 | _FUNCTION, RTLNAME(ChDrive) }, + { "string", SbxSTRING }, + +{ "Choose", SbxVARIANT, 2 | _FUNCTION, RTLNAME(Choose) }, + { "Index", SbxINTEGER }, + { "Expression", SbxVARIANT }, + +{ "Chr", SbxSTRING, 1 | _FUNCTION, RTLNAME(Chr) }, + { "string", SbxINTEGER }, + +{ "CInt", SbxINTEGER, 1 | _FUNCTION, RTLNAME(CInt) }, + { "expression", SbxVARIANT }, +{ "CLEAR_ALLTABS", SbxINTEGER, _CPROP, RTLNAME(CLEAR_ALLTABS) }, +{ "CLEAR_TAB", SbxINTEGER, _CPROP, RTLNAME(CLEAR_TAB) }, + +{ "CLng", SbxLONG, 1 | _FUNCTION, RTLNAME(CLng) }, + { "expression", SbxVARIANT }, +{ "Cos", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Cos) }, + { "number", SbxDOUBLE }, +{ "CreateObject", SbxOBJECT, 1 | _FUNCTION, RTLNAME( CreateObject ) }, + { "class", SbxSTRING }, +{ "CreateUnoListener",SbxOBJECT, 1 | _FUNCTION, RTLNAME( CreateUnoListener ) }, + { "prefix", SbxSTRING }, + { "typename", SbxSTRING }, +{ "CreateUnoService",SbxOBJECT, 1 | _FUNCTION, RTLNAME( CreateUnoService ) }, + { "servicename", SbxSTRING }, +{ "CreateUnoStruct",SbxOBJECT, 1 | _FUNCTION, RTLNAME( CreateUnoStruct ) }, + { "classname", SbxSTRING }, +{ "CreatePropertySet",SbxOBJECT, 1 | _FUNCTION, RTLNAME( CreatePropertySet ) }, + { "values", SbxARRAY }, +{ "CSng", SbxSINGLE, 1 | _FUNCTION, RTLNAME(CSng) }, + { "expression", SbxVARIANT }, +{ "CStr", SbxSTRING, 1 | _FUNCTION, RTLNAME(CStr) }, + { "expression", SbxVARIANT }, +{ "CurDir", SbxSTRING, 1 | _FUNCTION, RTLNAME(CurDir) }, + { "string", SbxSTRING }, +{ "CVar", SbxVARIANT, 1 | _FUNCTION, RTLNAME(CVar) }, + { "expression", SbxVARIANT }, +{ "CVErr", SbxVARIANT, 1 | _FUNCTION, RTLNAME(CVErr) }, + { "expression", SbxVARIANT }, +{ "Date", SbxSTRING, _LFUNCTION,RTLNAME(Date) }, +{ "DateAdd", SbxDATE, 1 | _FUNCTION, RTLNAME(DateAdd) }, + { "Interval", SbxSTRING }, + { "Number", SbxLONG }, + { "Date", SbxDATE }, +{ "DateDiff", SbxLONG, 1 | _FUNCTION, RTLNAME(DateDiff) }, + { "Interval", SbxSTRING }, + { "Date1", SbxDATE }, + { "Date2", SbxDATE }, +{ "DatePart", SbxLONG, 1 | _FUNCTION, RTLNAME(DatePart) }, + { "Interval", SbxSTRING }, + { "Date", SbxDATE }, +{ "DateSerial", SbxDATE, 3 | _FUNCTION, RTLNAME(DateSerial) }, + { "Year", SbxINTEGER }, + { "Month", SbxINTEGER }, + { "Day", SbxINTEGER }, +{ "DateValue", SbxDATE, 1 | _FUNCTION, RTLNAME(DateValue) }, + { "String", SbxSTRING }, +{ "Day", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Day) }, + { "Date", SbxDATE }, + +{ "Ddeexecute", SbxNULL, 2 | _FUNCTION, RTLNAME(DDEExecute) }, + { "Channel", SbxLONG }, + { "Command", SbxSTRING }, +{ "Ddeinitiate", SbxINTEGER, 2 | _FUNCTION, RTLNAME(DDEInitiate) }, + { "Application", SbxSTRING }, + { "Topic", SbxSTRING }, +{ "Ddepoke", SbxNULL, 3 | _FUNCTION, RTLNAME(DDEPoke) }, + { "Channel", SbxLONG }, + { "Item", SbxSTRING }, + { "Data", SbxSTRING }, +{ "Dderequest", SbxSTRING, 2 | _FUNCTION, RTLNAME(DDERequest) }, + { "Channel", SbxLONG }, + { "Item", SbxSTRING }, +{ "Ddeterminate", SbxNULL, 1 | _FUNCTION, RTLNAME(DDETerminate) }, + { "Channel", SbxLONG }, +{ "Ddeterminateall", SbxNULL, _FUNCTION, RTLNAME(DDETerminateAll) }, +{ "DimArray", SbxOBJECT, _FUNCTION, RTLNAME(DimArray) }, +{ "Dir", SbxSTRING, 2 | _FUNCTION, RTLNAME(Dir) }, + { "FileSpec", SbxSTRING, _OPT }, + { "attrmask", SbxINTEGER, _OPT }, +{ "DumpAllObjects", SbxEMPTY, 2 | _SUB, RTLNAME(DumpAllObjects) }, + { "FileSpec", SbxSTRING }, + { "DumpAll", SbxINTEGER, _OPT }, + +{ "EqualUnoObjects",SbxBOOL, 2 | _FUNCTION, RTLNAME(EqualUnoObjects) }, + { "Variant", SbxVARIANT }, + { "Variant", SbxVARIANT }, +{ "EnableReschedule", SbxNULL, 1 | _FUNCTION, RTLNAME(EnableReschedule) }, + { "bEnable", SbxBOOL }, +{ "Environ", SbxSTRING, 1 | _FUNCTION, RTLNAME(Environ) }, + { "Environmentstring",SbxSTRING }, +{ "EOF", SbxBOOL, 1 | _FUNCTION, RTLNAME(EOF) }, + { "Channel", SbxINTEGER }, +{ "Erl", SbxLONG, _ROPROP, RTLNAME( Erl ) }, +{ "Err", SbxLONG, _RWPROP, RTLNAME( Err ) }, +{ "Error", SbxSTRING, 1 | _FUNCTION, RTLNAME( Error ) }, + { "code", SbxLONG }, +{ "Exp", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Exp) }, + { "number", SbxDOUBLE }, +{ "False", SbxBOOL, _CPROP, RTLNAME(False) }, +{ "FileAttr", SbxINTEGER, 2 | _FUNCTION, RTLNAME(FileAttr) }, + { "Channel", SbxINTEGER }, + { "Attributes", SbxINTEGER }, +{ "FileCopy", SbxNULL, 2 | _FUNCTION, RTLNAME(FileCopy) }, + { "Source", SbxSTRING }, + { "Destination", SbxSTRING }, +{ "FileDateTime", SbxSTRING, 1 | _FUNCTION, RTLNAME(FileDateTime) }, + { "filename", SbxSTRING }, +{ "FileExists", SbxBOOL, 1 | _FUNCTION, RTLNAME(FileExists) }, + { "filename", SbxSTRING }, +{ "FileLen", SbxLONG, 1 | _FUNCTION, RTLNAME(FileLen) }, + { "filename", SbxSTRING }, +{ "FindObject", SbxOBJECT, 1 | _FUNCTION, RTLNAME(FindObject) }, + { "Name", SbxSTRING }, +{ "FindPropertyObject", SbxOBJECT, 2 | _FUNCTION, RTLNAME(FindPropertyObject) }, + { "Object", SbxOBJECT }, + { "Name", SbxSTRING }, +{ "Fix", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Fix) }, + { "number", SbxDOUBLE }, +{ "Format", SbxSTRING, 2 | _FUNCTION, RTLNAME(Format) }, + { "expression", SbxVARIANT }, + { "format", SbxSTRING, _OPT }, + +{ "FRAMEANCHORCHAR", SbxINTEGER, _CPROP, RTLNAME(FRAMEANCHORCHAR) }, +{ "FRAMEANCHORPAGE", SbxINTEGER, _CPROP, RTLNAME(FRAMEANCHORPAGE) }, +{ "FRAMEANCHORPARA", SbxINTEGER, _CPROP, RTLNAME(FRAMEANCHORPARA) }, + +{ "FreeFile", SbxINTEGER, _FUNCTION, RTLNAME(FreeFile) }, +{ "FreeLibrary", SbxNULL, 1 | _FUNCTION, RTLNAME(FreeLibrary) }, + { "Modulename", SbxSTRING }, + +{ "Get", SbxNULL, 3 | _FUNCTION, RTLNAME(Get) }, + { "filenumber", SbxINTEGER }, + { "recordnumber", SbxLONG }, + { "variablename", SbxVARIANT }, + +{ "GetAttr", SbxINTEGER, 1 | _FUNCTION, RTLNAME(GetAttr) }, + { "filename", SbxSTRING }, +{ "GetDialogZoomFactorX", SbxDOUBLE, _FUNCTION,RTLNAME(GetDialogZoomFactorX) }, +{ "GetDialogZoomFactorY", SbxDOUBLE, _FUNCTION,RTLNAME(GetDialogZoomFactorY) }, +{ "GetGUIType", SbxINTEGER, _FUNCTION,RTLNAME(GetGUIType) }, +{ "GetGUIVersion", SbxLONG, _FUNCTION,RTLNAME(GetGUIVersion) }, +{ "GetPathSeparator", SbxSTRING, _FUNCTION,RTLNAME(GetPathSeparator) }, +{ "GetProcessServiceManager", SbxOBJECT, 0 | _FUNCTION, RTLNAME(GetProcessServiceManager) }, +{ "GetSolarVersion", SbxLONG, _FUNCTION,RTLNAME(GetSolarVersion) }, +{ "GetSystemTicks", SbxLONG, _FUNCTION,RTLNAME(GetSystemTicks) }, +{ "GetSystemType", SbxINTEGER, _FUNCTION,RTLNAME(GetSystemType) }, +{ "Green", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Green) }, + { "RGB-Value", SbxLONG }, + +{ "HasUnoInterfaces", SbxBOOL, 1 | _FUNCTION, RTLNAME(HasUnoInterfaces) }, + { "InterfaceName",SbxSTRING }, +{ "Hex", SbxSTRING, 1 | _FUNCTION, RTLNAME(Hex) }, + { "number", SbxLONG }, +{ "Hour", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Hour) }, + { "Date", SbxDATE }, + +{ "IDABORT", SbxINTEGER, _CPROP, RTLNAME(IDABORT) }, +{ "IDCANCEL", SbxINTEGER, _CPROP, RTLNAME(IDCANCEL) }, +{ "IDNO", SbxINTEGER, _CPROP, RTLNAME(IDNO) }, +{ "IDOK", SbxINTEGER, _CPROP, RTLNAME(IDOK) }, +{ "IDRETRY", SbxINTEGER, _CPROP, RTLNAME(IDRETRY) }, +{ "IDYES", SbxINTEGER, _CPROP, RTLNAME(IDYES) }, + +{ "Iif", SbxVARIANT, 3 | _FUNCTION, RTLNAME(Iif) }, + { "Bool", SbxBOOL }, + { "Variant1", SbxVARIANT }, + { "Variant2", SbxVARIANT }, + +{ "InputBox", SbxSTRING, 5 | _FUNCTION, RTLNAME(InputBox) }, + { "Prompt", SbxSTRING }, + { "Title", SbxSTRING, _OPT }, + { "Default", SbxSTRING, _OPT }, + { "XPosTwips", SbxLONG, _OPT }, + { "YPosTwips", SbxLONG, _OPT }, +{ "InStr", SbxINTEGER, 4 | _FUNCTION, RTLNAME(InStr) }, + { "StartPos", SbxSTRING, _OPT }, + { "String1", SbxSTRING }, + { "String2", SbxSTRING }, + { "Compare", SbxINTEGER, _OPT }, +{ "Int", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Int) }, + { "number", SbxDOUBLE }, +{ "IsArray", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsArray) }, + { "Variant", SbxVARIANT }, +{ "IsDate", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsDate) }, + { "Variant", SbxVARIANT }, +{ "IsEmpty", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsEmpty) }, + { "Variant", SbxVARIANT }, +{ "IsError", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsError) }, + { "Variant", SbxVARIANT }, +{ "IsMissing", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsMissing) }, + { "Variant", SbxVARIANT }, +{ "IsNull", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsNull) }, + { "Variant", SbxVARIANT }, +{ "IsNumeric", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsNumeric) }, + { "Variant", SbxVARIANT }, +{ "IsObject", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsObject) }, + { "Variant", SbxVARIANT }, +{ "IsUnoStruct", SbxBOOL, 1 | _FUNCTION, RTLNAME(IsUnoStruct) }, + { "Variant", SbxVARIANT }, +{ "Kill", SbxNULL, 1 | _FUNCTION, RTLNAME(Kill) }, + { "filespec", SbxSTRING }, +{ "LBound", SbxINTEGER, 1 | _FUNCTION, RTLNAME(LBound) }, + { "Variant", SbxVARIANT }, +{ "LCase", SbxSTRING, 1 | _FUNCTION, RTLNAME(LCase) }, + { "string", SbxSTRING }, +{ "Left", SbxSTRING, 2 | _FUNCTION, RTLNAME(Left) }, + { "String", SbxSTRING }, + { "Count", SbxLONG }, +{ "Len", SbxLONG, 1 | _FUNCTION, RTLNAME(Len) }, + { "StringOrVariant", SbxVARIANT }, +{ "Load", SbxNULL, 1 | _FUNCTION, RTLNAME(Load) }, + { "object", SbxOBJECT }, +{ "LoadPicture", SbxOBJECT, 1 | _FUNCTION, RTLNAME(LoadPicture) }, + { "string", SbxSTRING }, +{ "Loc", SbxLONG, 1 | _FUNCTION, RTLNAME(Loc) }, + { "Channel", SbxINTEGER }, +{ "Lof", SbxLONG, 1 | _FUNCTION, RTLNAME(Lof) }, + { "Channel", SbxINTEGER }, +{ "Log", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Log) }, + { "number", SbxDOUBLE }, +{ "LTrim", SbxSTRING, 1 | _FUNCTION, RTLNAME(LTrim) }, + { "string", SbxSTRING }, + +{ "MB_ABORTRETRYIGNORE", SbxINTEGER, _CPROP, RTLNAME(MB_ABORTRETRYIGNORE)}, +{ "MB_APPLMODAL", SbxINTEGER, _CPROP, RTLNAME(MB_APPLMODAL) }, +{ "MB_DEFBUTTON1", SbxINTEGER, _CPROP, RTLNAME(MB_DEFBUTTON1) }, +{ "MB_DEFBUTTON2", SbxINTEGER, _CPROP, RTLNAME(MB_DEFBUTTON2) }, +{ "MB_DEFBUTTON3", SbxINTEGER, _CPROP, RTLNAME(MB_DEFBUTTON3) }, +{ "MB_ICONEXCLAMATION", SbxINTEGER, _CPROP, RTLNAME(MB_ICONEXCLAMATION)}, +{ "MB_ICONINFORMATION", SbxINTEGER, _CPROP, RTLNAME(MB_ICONINFORMATION)}, +{ "MB_ICONQUESTION",SbxINTEGER, _CPROP, RTLNAME(MB_ICONQUESTION) }, +{ "MB_ICONSTOP", SbxINTEGER, _CPROP, RTLNAME(MB_ICONSTOP) }, +{ "MB_OK", SbxINTEGER, _CPROP, RTLNAME(MB_OK) }, +{ "MB_OKCANCEL", SbxINTEGER, _CPROP, RTLNAME(MB_OKCANCEL) }, +{ "MB_RETRYCANCEL", SbxINTEGER, _CPROP, RTLNAME(MB_RETRYCANCEL) }, +{ "MB_SYSTEMMODAL", SbxINTEGER, _CPROP, RTLNAME(MB_SYSTEMMODAL) }, +{ "MB_YESNO", SbxINTEGER, _CPROP, RTLNAME(MB_YESNO) }, +{ "MB_YESNOCANCEL", SbxINTEGER, _CPROP, RTLNAME(MB_YESNOCANCEL) }, + + +{ "Mid", SbxSTRING, 3 | _LFUNCTION,RTLNAME(Mid) }, + { "String", SbxSTRING }, + { "StartPos", SbxLONG } , + { "Length", SbxLONG, _OPT } , +{ "Minute", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Minute) }, + { "Date", SbxDATE }, +{ "MkDir", SbxNULL, 1 | _FUNCTION, RTLNAME(MkDir) }, + { "pathname", SbxSTRING }, +{ "Month", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Month) }, + { "Date", SbxDATE }, +{ "MsgBox", SbxINTEGER, 3 | _FUNCTION, RTLNAME(MsgBox) }, + { "Message", SbxSTRING }, + { "Type", SbxINTEGER, _OPT }, + { "Title", SbxSTRING, _OPT }, + +{ "Nothing", SbxOBJECT, _CPROP, RTLNAME(Nothing) }, +{ "Now", SbxDATE, _FUNCTION, RTLNAME(Now) }, +{ "Null", SbxOBJECT, _CPROP, RTLNAME(Null) }, +{ "Oct", SbxSTRING, 1 | _FUNCTION, RTLNAME(Oct) }, + { "number", SbxLONG }, +{ "Pi", SbxDOUBLE, _CPROP, RTLNAME(PI) }, + +{ "Put", SbxNULL, 3 | _FUNCTION, RTLNAME(Put) }, + { "filenumber", SbxINTEGER }, + { "recordnumber", SbxLONG }, + { "variablename", SbxVARIANT }, + +{ "QBColor", SbxLONG, 1 | _FUNCTION, RTLNAME(QBColor) }, + { "number", SbxINTEGER }, +{ "Randomize", SbxNULL, 1 | _FUNCTION, RTLNAME(Randomize) }, + { "Number", SbxDOUBLE, _OPT }, +{ "Red", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Red) }, + { "RGB-Value", SbxLONG }, +{ "Reset", SbxNULL, 0 | _FUNCTION, RTLNAME(Reset) }, +{ "ResolvePath", SbxSTRING, 1 | _FUNCTION, RTLNAME(ResolvePath) }, + { "Path", SbxSTRING }, +{ "RGB", SbxLONG, 3 | _FUNCTION, RTLNAME(RGB) }, + { "Red", SbxINTEGER }, + { "Green", SbxINTEGER }, + { "Blue", SbxINTEGER }, + +{ "Right", SbxSTRING, 2 | _FUNCTION, RTLNAME(Right) }, + { "String", SbxSTRING }, + { "Count", SbxLONG } , +{ "RmDir", SbxNULL, 1 | _FUNCTION, RTLNAME(RmDir) }, + { "pathname", SbxSTRING }, +{ "Rnd", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Rnd) }, + { "Number", SbxDOUBLE, _OPT }, +{ "RTrim", SbxSTRING, 1 | _FUNCTION, RTLNAME(RTrim) }, + { "string", SbxSTRING }, +{ "SavePicture", SbxNULL, 2 | _FUNCTION, RTLNAME(SavePicture) }, + { "object", SbxOBJECT }, + { "string", SbxSTRING }, +{ "Second", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Second) }, + { "Date", SbxDATE }, +{ "Seek", SbxLONG, 1 | _FUNCTION, RTLNAME(Seek) }, + { "Channel", SbxINTEGER }, + +{ "SendKeys", SbxNULL, 2 | _FUNCTION, RTLNAME(SendKeys) }, + { "String", SbxSTRING }, + { "Wait", SbxBOOL, _OPT } , +{ "SetAttr", SbxNULL, 2 | _FUNCTION, RTLNAME(SetAttr) }, + { "File" , SbxSTRING }, + { "Attributes", SbxINTEGER } , +{ "SET_OFF", SbxINTEGER, _CPROP, RTLNAME(SET_OFF) }, +{ "SET_ON", SbxINTEGER, _CPROP, RTLNAME(SET_ON) }, +{ "SET_TAB", SbxINTEGER, _CPROP, RTLNAME(SET_TAB) }, + +{ "Sgn", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Sgn) }, + { "number", SbxDOUBLE }, +{ "Shell", SbxLONG, 2 | _FUNCTION, RTLNAME(Shell) }, + { "Commandstring",SbxSTRING }, + { "WindowStyle", SbxINTEGER, _OPT }, +{ "Sin", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Sin) }, + { "number", SbxDOUBLE }, +{ "Space", SbxSTRING, 1 | _FUNCTION, RTLNAME(Space) }, + { "string", SbxLONG }, +{ "Spc", SbxSTRING, 1 | _FUNCTION, RTLNAME(Spc) }, + { "Count", SbxLONG }, +{ "Sqr", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Sqr) }, + { "number", SbxDOUBLE }, +{ "Str", SbxSTRING, 1 | _FUNCTION, RTLNAME(Str) }, + { "number", SbxDOUBLE }, +{ "StrComp", SbxINTEGER, 3 | _FUNCTION, RTLNAME(StrComp) }, + { "String1", SbxSTRING }, + { "String2", SbxSTRING }, + { "Compare", SbxINTEGER, _OPT }, +{ "StrConv", SbxSTRING, 2 | _FUNCTION, RTLNAME(StrConv) }, + { "String", SbxSTRING }, + { "Conversion", SbxSTRING }, +{ "String", SbxSTRING, 2 | _FUNCTION, RTLNAME(String) }, + { "Count", SbxLONG }, + { "Filler", SbxVARIANT }, + +{ "Switch", SbxVARIANT, 2 | _FUNCTION, RTLNAME(Switch) }, + { "Expression", SbxVARIANT }, + { "Value", SbxVARIANT }, + +{ "Tan", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Tan) }, + { "number", SbxDOUBLE }, +{ "Time", SbxVARIANT, _LFUNCTION,RTLNAME(Time) }, +{ "Timer", SbxDATE, _FUNCTION, RTLNAME(Timer) }, +{ "TimeSerial", SbxDATE, 3 | _FUNCTION, RTLNAME(TimeSerial) }, + { "Hour", SbxLONG }, + { "Minute", SbxLONG }, + { "Second", SbxLONG }, +{ "TimeValue", SbxDATE, 1 | _FUNCTION, RTLNAME(TimeValue) }, + { "String", SbxSTRING }, + +{ "TOGGLE", SbxINTEGER, _CPROP, RTLNAME(TOGGLE) }, + +{ "Trim", SbxSTRING, 1 | _FUNCTION, RTLNAME(Trim) }, + { "String", SbxSTRING }, +{ "True", SbxBOOL, _CPROP, RTLNAME(True) }, +{ "TwipsPerPixelX", SbxLONG, _FUNCTION, RTLNAME(TwipsPerPixelX) }, +{ "TwipsPerPixelY", SbxLONG, _FUNCTION, RTLNAME(TwipsPerPixelY) }, + +{ "TYP_AUTHORFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_AUTHORFLD) }, +{ "TYP_CHAPTERFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_CHAPTERFLD) }, +{ "TYP_CONDTXTFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_CONDTXTFLD) }, +{ "TYP_DATEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DATEFLD) }, +{ "TYP_DBFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DBFLD) }, +{ "TYP_DBNAMEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DBNAMEFLD) }, +{ "TYP_DBNEXTSETFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DBNEXTSETFLD) }, +{ "TYP_DBNUMSETFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DBNUMSETFLD) }, +{ "TYP_DBSETNUMBERFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DBSETNUMBERFLD) }, +{ "TYP_DDEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DDEFLD) }, +{ "TYP_DOCINFOFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DOCINFOFLD) }, +{ "TYP_DOCSTATFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_DOCSTATFLD) }, +{ "TYP_EXTUSERFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_EXTUSERFLD) }, +{ "TYP_FILENAMEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_FILENAMEFLD) }, +{ "TYP_FIXDATEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_FIXDATEFLD) }, +{ "TYP_FIXTIMEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_FIXTIMEFLD) }, +{ "TYP_FORMELFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_FORMELFLD) }, +{ "TYP_GETFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_GETFLD) }, +{ "TYP_GETREFFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_GETREFFLD) }, +{ "TYP_GETREFPAGEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_GETREFPAGEFLD) }, +{ "TYP_HIDDENPARAFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_HIDDENPARAFLD) }, +{ "TYP_HIDDENTXTFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_HIDDENTXTFLD) }, +{ "TYP_INPUTFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_INPUTFLD) }, +{ "TYP_INTERNETFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_INTERNETFLD) }, +{ "TYP_JUMPEDITFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_JUMPEDITFLD) }, +{ "TYP_MACROFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_MACROFLD) }, +{ "TYP_NEXTPAGEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_NEXTPAGEFLD) }, +{ "TYP_PAGENUMBERFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_PAGENUMBERFLD) }, +{ "TYP_POSTITFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_POSTITFLD) }, +{ "TYP_PREVPAGEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_PREVPAGEFLD) }, +{ "TYP_SEQFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_SEQFLD) }, +{ "TYP_SETFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_SETFLD) }, +{ "TYP_SETINPFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_SETINPFLD) }, +{ "TYP_SETREFFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_SETREFFLD) }, +{ "TYP_SETREFPAGEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_SETREFPAGEFLD) }, +{ "TYP_TEMPLNAMEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_TEMPLNAMEFLD) }, +{ "TYP_TIMEFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_TIMEFLD) }, +{ "TYP_USERFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_USERFLD) }, +{ "TYP_USRINPFLD", SbxINTEGER, _CPROP, RTLNAME(TYP_USRINPFLD) }, + +{ "TypeLen", SbxINTEGER, 1 | _FUNCTION, RTLNAME(TypeLen) }, + { "Var", SbxVARIANT }, +{ "TypeName", SbxSTRING, 1 | _FUNCTION, RTLNAME(TypeName) }, + { "Var", SbxVARIANT }, +{ "UBound", SbxINTEGER, 1 | _FUNCTION, RTLNAME(UBound) }, + { "Var", SbxVARIANT }, +{ "UCase", SbxSTRING, 1 | _FUNCTION, RTLNAME(UCase) }, + { "String", SbxSTRING }, +{ "Unload", SbxNULL, 1 | _FUNCTION, RTLNAME(Unload) }, + { "Dialog", SbxOBJECT }, +{ "Val", SbxDOUBLE, 1 | _FUNCTION, RTLNAME(Val) }, + { "String", SbxSTRING }, +{ "VarType", SbxINTEGER, 1 | _FUNCTION, RTLNAME(VarType) }, + { "Var", SbxVARIANT }, +{ "V_EMPTY", SbxINTEGER, _CPROP, RTLNAME(V_EMPTY) }, +{ "V_NULL", SbxINTEGER, _CPROP, RTLNAME(V_NULL) }, +{ "V_INTEGER", SbxINTEGER, _CPROP, RTLNAME(V_INTEGER) }, +{ "V_LONG", SbxINTEGER, _CPROP, RTLNAME(V_LONG) }, +{ "V_SINGLE", SbxINTEGER, _CPROP, RTLNAME(V_SINGLE) }, +{ "V_DOUBLE", SbxINTEGER, _CPROP, RTLNAME(V_DOUBLE) }, +{ "V_CURRENCY", SbxINTEGER, _CPROP, RTLNAME(V_CURRENCY) }, +{ "V_DATE", SbxINTEGER, _CPROP, RTLNAME(V_DATE) }, +{ "V_STRING", SbxINTEGER, _CPROP, RTLNAME(V_STRING) }, + +{ "Wait", SbxNULL, 1 | _FUNCTION, RTLNAME(Wait) }, + { "Milliseconds", SbxLONG }, +{ "Weekday", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Weekday) }, + { "Date", SbxDATE }, +{ "Year", SbxINTEGER, 1 | _FUNCTION, RTLNAME(Year) }, + { "Date", SbxDATE }, + +{ NULL, SbxNULL, -1 }}; // Tabellenende + +SbiStdObject::SbiStdObject( const String& r, StarBASIC* pb ) : SbxObject( r ) +{ + // Muessen wir die Hashcodes initialisieren? + Methods* p = aMethods; + if( !p->nHash ) + while( p->nArgs != -1 ) + { + String aName = String::CreateFromAscii( p->pName ); + p->nHash = SbxVariable::MakeHashCode( aName ); + p += ( p->nArgs & _ARGSMASK ) + 1; + } + + SetParent( pb ); + + pStdFactory = new SbStdFactory; + SbxBase::AddFactory( pStdFactory ); + + Insert( new SbStdClipboard ); +} + +SbiStdObject::~SbiStdObject() +{ + SbxBase::RemoveFactory( pStdFactory ); + delete pStdFactory; +} + +// Suche nach einem Element: +// Hier wird linear durch die Methodentabelle gegangen, bis eine +// passende Methode gefunden wurde. Auf Grund der Bits im nArgs-Feld +// wird dann die passende Instanz eines SbxObjElement generiert. +// Wenn die Methode/Property nicht gefunden wurde, nur NULL ohne +// Fehlercode zurueckliefern, da so auch eine ganze Chain von +// Objekten nach der Methode/Property befragt werden kann. + +SbxVariable* SbiStdObject::Find( const String& rName, SbxClassType t ) +{ + // Bereits eingetragen? + SbxVariable* pVar = SbxObject::Find( rName, t ); + if( !pVar ) + { + // sonst suchen + USHORT nHash = SbxVariable::MakeHashCode( rName ); + Methods* p = aMethods; + BOOL bFound = FALSE; + short nIndex = 0; + USHORT nSrchMask = _TYPEMASK; + switch( t ) + { + case SbxCLASS_METHOD: nSrchMask = _METHOD; break; + case SbxCLASS_PROPERTY: nSrchMask = _PROPERTY; break; + case SbxCLASS_OBJECT: nSrchMask = _OBJECT; break; + } + while( p->nArgs != -1 ) + { + if( ( p->nArgs & nSrchMask ) + && ( p->nHash == nHash ) + && ( rName.EqualsIgnoreCaseAscii( p->pName ) ) ) + { + bFound = TRUE; break; + } + nIndex += ( p->nArgs & _ARGSMASK ) + 1; + p = aMethods + nIndex; + } + if( bFound ) + { + // Args-Felder isolieren: + short nAccess = ( p->nArgs & _RWMASK ) >> 8; + short nType = ( p->nArgs & _TYPEMASK ); + if( p->nArgs & _CONST ) + nAccess |= SBX_CONST; + String aName = String::CreateFromAscii( p->pName ); + SbxClassType eCT = SbxCLASS_OBJECT; + if( nType & _PROPERTY ) + eCT = SbxCLASS_PROPERTY; + else if( nType & _METHOD ) + eCT = SbxCLASS_METHOD; + pVar = Make( aName, eCT, p->eType ); + pVar->SetUserData( nIndex + 1 ); + pVar->SetFlags( nAccess ); + } + } + return pVar; +} + +// SetModified muß bei der RTL abgklemmt werden +void SbiStdObject::SetModified( BOOL ) +{ +} + +// Aufruf einer Property oder Methode. + +void SbiStdObject::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType, + const SfxHint& rHint, const TypeId& rHintType ) + +{ + const SbxHint* pHint = PTR_CAST(SbxHint,&rHint); + if( pHint ) + { + SbxVariable* pVar = pHint->GetVar(); + SbxArray* pPar = pVar->GetParameters(); + ULONG t = pHint->GetId(); + USHORT nCallId = (USHORT) pVar->GetUserData(); + if( nCallId ) + { + if( t == SBX_HINT_INFOWANTED ) + pVar->SetInfo( GetInfo( (short) pVar->GetUserData() ) ); + else + { + BOOL bWrite = FALSE; + if( t == SBX_HINT_DATACHANGED ) + bWrite = TRUE; + if( t == SBX_HINT_DATAWANTED || bWrite ) + { + RtlCall p = (RtlCall) aMethods[ nCallId-1 ].pFunc; + SbxArrayRef rPar( pPar ); + if( !pPar ) + { + rPar = pPar = new SbxArray; + pPar->Put( pVar, 0 ); + } + p( (StarBASIC*) GetParent(), *pPar, bWrite ); + return; + } + } + } + SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType ); + } +} + +// Zusammenbau der Infostruktur fuer einzelne Elemente +// Falls nIdx = 0, nix erzeugen (sind Std-Props!) + +SbxInfo* SbiStdObject::GetInfo( short nIdx ) +{ + if( !nIdx ) + return NULL; + Methods* p = &aMethods[ --nIdx ]; + // Wenn mal eine Hilfedatei zur Verfuegung steht: + // SbxInfo* pInfo = new SbxInfo( Hilfedateiname, p->nHelpId ); + SbxInfo* pInfo = new SbxInfo; + short nPar = p->nArgs & _ARGSMASK; + for( short i = 0; i < nPar; i++ ) + { + p++; + String aName = String::CreateFromAscii( p->pName ); + USHORT nFlags = ( p->nArgs >> 8 ) & 0x03; + if( p->nArgs & _OPT ) + nFlags |= SBX_OPTIONAL; + pInfo->AddParam( aName, p->eType, nFlags ); + } + return pInfo; +} + diff --git a/basic/source/runtime/stdobj1.cxx b/basic/source/runtime/stdobj1.cxx new file mode 100644 index 000000000000..e72786422d9b --- /dev/null +++ b/basic/source/runtime/stdobj1.cxx @@ -0,0 +1,547 @@ +/************************************************************************* + * + * $RCSfile: stdobj1.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _SV_WRKWIN_HXX //autogen +#include <vcl/wrkwin.hxx> +#endif +#ifndef _SV_SVAPP_HXX //autogen +#include <vcl/svapp.hxx> +#endif +#ifndef _SV_CLIP_HXX //autogen +#include <vcl/clip.hxx> +#endif +#ifndef _SBXCLASS_HXX //autogen +#include <svtools/sbx.hxx> +#endif +#include "runtime.hxx" +#pragma hdrstop +#include "stdobj1.hxx" + +#include "segmentc.hxx" +//#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +#define ATTR_IMP_TYPE 1 +#define ATTR_IMP_WIDTH 2 +#define ATTR_IMP_HEIGHT 3 +#define ATTR_IMP_BOLD 4 +#define ATTR_IMP_ITALIC 5 +#define ATTR_IMP_STRIKETHROUGH 6 +#define ATTR_IMP_UNDERLINE 7 +#define ATTR_IMP_WEIGHT 8 +#define ATTR_IMP_SIZE 9 +#define ATTR_IMP_NAME 10 + +#define METH_CLEAR 20 +#define METH_GETDATA 21 +#define METH_GETFORMAT 22 +#define METH_GETTEXT 23 +#define METH_SETDATA 24 +#define METH_SETTEXT 25 + +//------------------------------------------------------------------------------ +SbStdFactory::SbStdFactory() +{ +} + +SbxObject* SbStdFactory::CreateObject( const String& rClassName ) +{ + if( rClassName.EqualsIgnoreCaseAscii( String( RTL_CONSTASCII_USTRINGPARAM("Picture") ) ) ) + return new SbStdPicture; + else + if( rClassName.EqualsIgnoreCaseAscii( String( RTL_CONSTASCII_USTRINGPARAM("Font") ) ) ) + return new SbStdFont; + else + return NULL; +} + +//------------------------------------------------------------------------------ + + + +void SbStdPicture::PropType( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + { + StarBASIC::Error( SbERR_PROP_READONLY ); + return; + } + + GraphicType eType = aGraphic.GetType(); + INT16 nType = 0; + + if( eType == GRAPHIC_BITMAP ) + nType = 1; + else + if( eType != GRAPHIC_NONE ) + nType = 2; + + pVar->PutInteger( nType ); +} + + +void SbStdPicture::PropWidth( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + { + StarBASIC::Error( SbERR_PROP_READONLY ); + return; + } + + Size aSize = aGraphic.GetPrefSize(); + aSize = GetpApp()->GetAppWindow()->LogicToPixel( aSize, aGraphic.GetPrefMapMode() ); + aSize = GetpApp()->GetAppWindow()->PixelToLogic( aSize, MapMode( MAP_TWIP ) ); + + pVar->PutInteger( (INT16)aSize.Width() ); +} + +void SbStdPicture::PropHeight( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + { + StarBASIC::Error( SbERR_PROP_READONLY ); + return; + } + + Size aSize = aGraphic.GetPrefSize(); + aSize = GetpApp()->GetAppWindow()->LogicToPixel( aSize, aGraphic.GetPrefMapMode() ); + aSize = GetpApp()->GetAppWindow()->PixelToLogic( aSize, MapMode( MAP_TWIP ) ); + + pVar->PutInteger( (INT16)aSize.Height() ); +} + + +TYPEINIT1( SbStdPicture, SbxObject ); + +SbStdPicture::SbStdPicture() : + SbxObject( String( RTL_CONSTASCII_USTRINGPARAM("Picture") ) ) +{ + // Properties + SbxVariable* p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Type") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READ | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_TYPE ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Width") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READ | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_WIDTH ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Height") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READ | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_HEIGHT ); +} + +SbStdPicture::~SbStdPicture() +{ +} + + +SbxVariable* SbStdPicture::Find( const String& rName, SbxClassType t ) +{ + // Bereits eingetragen? + return SbxObject::Find( rName, t ); +} + + + +void SbStdPicture::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType, + const SfxHint& rHint, const TypeId& rHintType ) + +{ + const SbxHint* pHint = PTR_CAST( SbxHint, &rHint ); + + if( pHint ) + { + if( pHint->GetId() == SBX_HINT_INFOWANTED ) + { + SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType ); + return; + } + + SbxVariable* pVar = pHint->GetVar(); + SbxArray* pPar = pVar->GetParameters(); + USHORT nWhich = (USHORT)pVar->GetUserData(); + BOOL bWrite = pHint->GetId() == SBX_HINT_DATACHANGED; + + // Propteries + switch( nWhich ) + { + case ATTR_IMP_TYPE: PropType( pVar, pPar, bWrite ); return; + case ATTR_IMP_WIDTH: PropWidth( pVar, pPar, bWrite ); return; + case ATTR_IMP_HEIGHT: PropHeight( pVar, pPar, bWrite ); return; + } + + SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType ); + } +} + +//----------------------------------------------------------------------------- + +void SbStdFont::PropBold( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + SetBold( pVar->GetBool() ); + else + pVar->PutBool( IsBold() ); +} + +void SbStdFont::PropItalic( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + SetItalic( pVar->GetBool() ); + else + pVar->PutBool( IsItalic() ); +} + +void SbStdFont::PropStrikeThrough( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + SetStrikeThrough( pVar->GetBool() ); + else + pVar->PutBool( IsStrikeThrough() ); +} + +void SbStdFont::PropUnderline( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + SetUnderline( pVar->GetBool() ); + else + pVar->PutBool( IsUnderline() ); +} + +void SbStdFont::PropSize( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + SetSize( (USHORT)pVar->GetInteger() ); + else + pVar->PutInteger( (INT16)GetSize() ); +} + +void SbStdFont::PropName( SbxVariable* pVar, SbxArray*, BOOL bWrite ) +{ + if( bWrite ) + SetFontName( pVar->GetString() ); + else + pVar->PutString( GetFontName() ); +} + + +TYPEINIT1( SbStdFont, SbxObject ); + +SbStdFont::SbStdFont() : + SbxObject( String( RTL_CONSTASCII_USTRINGPARAM("Font") ) ) +{ + // Properties + SbxVariable* p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Bold") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READWRITE | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_BOLD ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Italic") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READWRITE | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_ITALIC ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("StrikeThrough") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READWRITE | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_STRIKETHROUGH ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Underline") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READWRITE | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_UNDERLINE ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Size") ), SbxCLASS_PROPERTY, SbxVARIANT ); + p->SetFlags( SBX_READWRITE | SBX_DONTSTORE ); + p->SetUserData( ATTR_IMP_SIZE ); + + // Name Property selbst verarbeiten + p = Find( String( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_PROPERTY ); + DBG_ASSERT( p, "Keine Name Property" ); + p->SetUserData( ATTR_IMP_NAME ); +} + +SbStdFont::~SbStdFont() +{ +} + + +SbxVariable* SbStdFont::Find( const String& rName, SbxClassType t ) +{ + // Bereits eingetragen? + return SbxObject::Find( rName, t ); +} + + + +void SbStdFont::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType, + const SfxHint& rHint, const TypeId& rHintType ) +{ + const SbxHint* pHint = PTR_CAST( SbxHint, &rHint ); + + if( pHint ) + { + if( pHint->GetId() == SBX_HINT_INFOWANTED ) + { + SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType ); + return; + } + + SbxVariable* pVar = pHint->GetVar(); + SbxArray* pPar = pVar->GetParameters(); + USHORT nWhich = (USHORT)pVar->GetUserData(); + BOOL bWrite = pHint->GetId() == SBX_HINT_DATACHANGED; + + // Propteries + switch( nWhich ) + { + case ATTR_IMP_BOLD: PropBold( pVar, pPar, bWrite ); return; + case ATTR_IMP_ITALIC: PropItalic( pVar, pPar, bWrite ); return; + case ATTR_IMP_STRIKETHROUGH:PropStrikeThrough( pVar, pPar, bWrite ); return; + case ATTR_IMP_UNDERLINE: PropUnderline( pVar, pPar, bWrite ); return; + case ATTR_IMP_SIZE: PropSize( pVar, pPar, bWrite ); return; + case ATTR_IMP_NAME: PropName( pVar, pPar, bWrite ); return; + } + + SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType ); + } +} + + +//----------------------------------------------------------------------------- +void SbStdClipboard::MethClear( SbxVariable*, SbxArray* pPar, BOOL ) +{ + if( pPar && (pPar->Count() > 1) ) + { + StarBASIC::Error( SbERR_BAD_NUMBER_OF_ARGS ); + return; + } + + Clipboard::Clear(); +} + +void SbStdClipboard::MethGetData( SbxVariable* pVar, SbxArray* pPar, BOOL ) +{ + if( !pPar || (pPar->Count() != 2) ) + { + StarBASIC::Error( SbERR_BAD_NUMBER_OF_ARGS ); + return; + } + + USHORT nFormat = pPar->Get(1)->GetInteger(); + if( !nFormat || nFormat > 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + if( nFormat == FORMAT_STRING ) + pVar->PutString( Clipboard::PasteString() ); + else + if( (nFormat == FORMAT_BITMAP) || + (nFormat == FORMAT_GDIMETAFILE ) ) + { + SbxObjectRef xPic = new SbStdPicture; + Graphic aGraph; + aGraph.Paste(); + ((SbStdPicture*)(SbxObject*)xPic)->SetGraphic( aGraph ); + pVar->PutObject( xPic ); + } +} + +void SbStdClipboard::MethGetFormat( SbxVariable* pVar, SbxArray* pPar, BOOL ) +{ + if( !pPar || (pPar->Count() != 2) ) + { + StarBASIC::Error( SbERR_BAD_NUMBER_OF_ARGS ); + return; + } + + USHORT nFormat = pPar->Get(1)->GetInteger(); + if( !nFormat || nFormat > 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + pVar->PutBool( Clipboard::HasFormat( nFormat ) ); +} + +void SbStdClipboard::MethGetText( SbxVariable* pVar, SbxArray* pPar, BOOL ) +{ + if( pPar && (pPar->Count() > 1) ) + { + StarBASIC::Error( SbERR_BAD_NUMBER_OF_ARGS ); + return; + } + + pVar->PutString( Clipboard::PasteString() ); +} + +void SbStdClipboard::MethSetData( SbxVariable* pVar, SbxArray* pPar, BOOL ) +{ + if( !pPar || (pPar->Count() != 3) ) + { + StarBASIC::Error( SbERR_BAD_NUMBER_OF_ARGS ); + return; + } + + USHORT nFormat = pPar->Get(2)->GetInteger(); + if( !nFormat || nFormat > 3 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return; + } + + if( nFormat == FORMAT_STRING ) + { + Clipboard::CopyString( pPar->Get(1)->GetString() ); + } + else + if( (nFormat == FORMAT_BITMAP) || + (nFormat == FORMAT_GDIMETAFILE) ) + { + SbxObject* pObj = (SbxObject*)pPar->Get(1)->GetObject(); + + if( pObj && pObj->IsA( TYPE( SbStdPicture ) ) ) + ((SbStdPicture*)(SbxObject*)pObj)->GetGraphic().Copy(); + } +} + +void SbStdClipboard::MethSetText( SbxVariable* pVar, SbxArray* pPar, BOOL ) +{ + if( !pPar || (pPar->Count() != 2) ) + { + StarBASIC::Error( SbERR_BAD_NUMBER_OF_ARGS ); + return; + } + + Clipboard::CopyString( pPar->Get(1)->GetString() ); +} + + +TYPEINIT1( SbStdClipboard, SbxObject ); + +SbStdClipboard::SbStdClipboard() : + SbxObject( String( RTL_CONSTASCII_USTRINGPARAM("Clipboard") ) ) +{ + // Name Property selbst verarbeiten + SbxVariable* p = Find( String( RTL_CONSTASCII_USTRINGPARAM("Name") ), SbxCLASS_PROPERTY ); + DBG_ASSERT( p, "Keine Name Property" ); + p->SetUserData( ATTR_IMP_NAME ); + + //Methoden registrieren + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("Clear") ), SbxCLASS_METHOD, SbxEMPTY ); + p->SetFlag( SBX_DONTSTORE ); + p->SetUserData( METH_CLEAR ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("GetData") ), SbxCLASS_METHOD, SbxEMPTY ); + p->SetFlag( SBX_DONTSTORE ); + p->SetUserData( METH_GETDATA ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("GetFormat") ), SbxCLASS_METHOD, SbxEMPTY ); + p->SetFlag( SBX_DONTSTORE ); + p->SetUserData( METH_GETFORMAT ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("GetText") ), SbxCLASS_METHOD, SbxEMPTY ); + p->SetFlag( SBX_DONTSTORE ); + p->SetUserData( METH_GETTEXT ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("SetData") ), SbxCLASS_METHOD, SbxEMPTY ); + p->SetFlag( SBX_DONTSTORE ); + p->SetUserData( METH_SETDATA ); + p = Make( String( RTL_CONSTASCII_USTRINGPARAM("SetText") ), SbxCLASS_METHOD, SbxEMPTY ); + p->SetFlag( SBX_DONTSTORE ); + p->SetUserData( METH_SETTEXT ); +} + +SbStdClipboard::~SbStdClipboard() +{ +} + + +SbxVariable* SbStdClipboard::Find( const String& rName, SbxClassType t ) +{ + // Bereits eingetragen? + return SbxObject::Find( rName, t ); +} + + + +void SbStdClipboard::SFX_NOTIFY( SfxBroadcaster& rBC, const TypeId& rBCType, + const SfxHint& rHint, const TypeId& rHintType ) +{ + const SbxHint* pHint = PTR_CAST( SbxHint, &rHint ); + + if( pHint ) + { + if( pHint->GetId() == SBX_HINT_INFOWANTED ) + { + SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType ); + return; + } + + SbxVariable* pVar = pHint->GetVar(); + SbxArray* pPar = pVar->GetParameters(); + USHORT nWhich = (USHORT)pVar->GetUserData(); + BOOL bWrite = pHint->GetId() == SBX_HINT_DATACHANGED; + + // Methods + switch( nWhich ) + { + case METH_CLEAR: MethClear( pVar, pPar, bWrite ); return; + case METH_GETDATA: MethGetData( pVar, pPar, bWrite ); return; + case METH_GETFORMAT: MethGetFormat( pVar, pPar, bWrite ); return; + case METH_GETTEXT: MethGetText( pVar, pPar, bWrite ); return; + case METH_SETDATA: MethSetData( pVar, pPar, bWrite ); return; + case METH_SETTEXT: MethSetText( pVar, pPar, bWrite ); return; + } + + SbxObject::SFX_NOTIFY( rBC, rBCType, rHint, rHintType ); + } +} + + diff --git a/basic/source/runtime/step0.cxx b/basic/source/runtime/step0.cxx new file mode 100644 index 000000000000..2b848e97a2d4 --- /dev/null +++ b/basic/source/runtime/step0.cxx @@ -0,0 +1,799 @@ +/************************************************************************* + * + * $RCSfile: step0.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#ifndef _SV_MSGBOX_HXX //autogen +#include <vcl/msgbox.hxx> +#endif +#ifndef _FSYS_HXX //autogen +#include <tools/fsys.hxx> +#endif + +#include <svtools/sbx.hxx> +#include "runtime.hxx" +#pragma hdrstop +#include "sbintern.hxx" +#include "iosys.hxx" +#include <sb.hrc> +#include <basrid.hxx> +#include "sbunoobj.hxx" +#include <com/sun/star/uno/Any.hxx> + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +void SbiRuntime::StepNOP() +{} + +void SbiRuntime::StepArith( SbxOperator eOp ) +{ + SbxVariableRef p1 = PopVar(); + TOSMakeTemp(); + SbxVariable* p2 = GetTOS(); + p2->ResetFlag( SBX_FIXED ); + p2->Compute( eOp, *p1 ); +} + +void SbiRuntime::StepUnary( SbxOperator eOp ) +{ + TOSMakeTemp(); + SbxVariable* p = GetTOS(); + p->Compute( eOp, *p ); +} + +void SbiRuntime::StepCompare( SbxOperator eOp ) +{ + SbxVariableRef p1 = PopVar(); + SbxVariableRef p2 = PopVar(); +#ifndef WIN + static SbxVariable* pTRUE = NULL; + static SbxVariable* pFALSE = NULL; + + if( p2->Compare( eOp, *p1 ) ) + { + if( !pTRUE ) + { + pTRUE = new SbxVariable; + pTRUE->PutBool( TRUE ); + pTRUE->AddRef(); + } + PushVar( pTRUE ); + } + else + { + if( !pFALSE ) + { + pFALSE = new SbxVariable; + pFALSE->PutBool( FALSE ); + pFALSE->AddRef(); + } + PushVar( pFALSE ); + } +#else + BOOL bRes = p2->Compare( eOp, *p1 ); + SbxVariable* pRes = new SbxVariable; + pRes->PutBool( bRes ); + PushVar( pRes ); +#endif +} + +void SbiRuntime::StepEXP() { StepArith( SbxEXP ); } +void SbiRuntime::StepMUL() { StepArith( SbxMUL ); } +void SbiRuntime::StepDIV() { StepArith( SbxDIV ); } +void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); } +void SbiRuntime::StepMOD() { StepArith( SbxMOD ); } +void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); } +void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); } +void SbiRuntime::StepCAT() { StepArith( SbxCAT ); } +void SbiRuntime::StepAND() { StepArith( SbxAND ); } +void SbiRuntime::StepOR() { StepArith( SbxOR ); } +void SbiRuntime::StepXOR() { StepArith( SbxXOR ); } +void SbiRuntime::StepEQV() { StepArith( SbxEQV ); } +void SbiRuntime::StepIMP() { StepArith( SbxIMP ); } + +void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); } +void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); } + +void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); } +void SbiRuntime::StepNE() { StepCompare( SbxNE ); } +void SbiRuntime::StepLT() { StepCompare( SbxLT ); } +void SbiRuntime::StepGT() { StepCompare( SbxGT ); } +void SbiRuntime::StepLE() { StepCompare( SbxLE ); } +void SbiRuntime::StepGE() { StepCompare( SbxGE ); } + +void SbiRuntime::StepLIKE() +{ + StarBASIC::FatalError( SbERR_NOT_IMPLEMENTED ); +} + +// TOS und TOS-1 sind beides Objektvariable und enthalten den selben Pointer + +void SbiRuntime::StepIS() +{ + SbxVariableRef refVar1 = PopVar(); + SbxVariableRef refVar2 = PopVar(); + BOOL bRes = BOOL( + refVar1->GetType() == SbxOBJECT + && refVar2->GetType() == SbxOBJECT + && refVar1->GetObject() == refVar2->GetObject() ); + SbxVariable* pRes = new SbxVariable; + pRes->PutBool( bRes ); + PushVar( pRes ); +} + +// Aktualisieren des Wertes von TOS + +void SbiRuntime::StepGET() +{ + SbxVariable* p = GetTOS(); + p->Broadcast( SBX_HINT_DATAWANTED ); +} + +// #67607 Uno-Structs kopieren +inline void checkUnoStructCopy( SbxVariableRef& refVal, SbxVariableRef& refVar ) +{ + SbxDataType eVarType = refVar->GetType(); + if( eVarType == SbxOBJECT ) + { + SbxObjectRef xVarObj = (SbxObject*)refVar->GetObject(); + SbxDataType eValType = refVal->GetType(); + if( eValType == SbxOBJECT && xVarObj == refVal->GetObject() ) + { + SbUnoObject* pUnoObj = PTR_CAST(SbUnoObject,(SbxObject*)xVarObj); + if( pUnoObj ) + { + Any aAny = pUnoObj->getUnoAny(); + if( aAny.getValueType().getTypeClass() == TypeClass_STRUCT ) + { + SbUnoObject* pNewUnoObj = new SbUnoObject( pUnoObj->GetName(), aAny ); + // #70324: ClassName uebernehmen + pNewUnoObj->SetClassName( pUnoObj->GetClassName() ); + refVar->PutObject( pNewUnoObj ); + } + } + } + } +} + +// Ablage von TOS in TOS-1 + +void SbiRuntime::StepPUT() +{ + SbxVariableRef refVal = PopVar(); + SbxVariableRef refVar = PopVar(); + // Store auf die eigene Methode (innerhalb einer Function)? + BOOL bFlagsChanged = FALSE; + USHORT n; + if( (SbxVariable*) refVar == (SbxVariable*) pMeth ) + { + bFlagsChanged = TRUE; + n = refVar->GetFlags(); + refVar->SetFlag( SBX_WRITE ); + } + *refVar = *refVal; + // #67607 Uno-Structs kopieren + checkUnoStructCopy( refVal, refVar ); + if( bFlagsChanged ) + refVar->SetFlags( n ); +} + + +// Speichern Objektvariable +// Nicht-Objekt-Variable fuehren zu Fehlern + +void SbiRuntime::StepSET() +{ + SbxVariableRef refVal = PopVar(); + SbxVariableRef refVar = PopVar(); + // #67733 Typen mit Array-Flag sind auch ok + SbxDataType eValType = refVal->GetType(); + SbxDataType eVarType = refVar->GetType(); + if( (eValType != SbxOBJECT && eValType != SbxEMPTY && !(eValType & SbxARRAY)) || + (eVarType != SbxOBJECT && !(eVarType & SbxARRAY) ) ) + { + Error( SbERR_INVALID_USAGE_OBJECT ); + } + else + { + // Auf refVal GetObject fuer Collections ausloesen + SbxBase* pObjVarObj = refVal->GetObject(); + if( pObjVarObj ) + { + SbxVariableRef refObjVal = PTR_CAST(SbxObject,pObjVarObj); + + // #67733 Typen mit Array-Flag sind auch ok + if( refObjVal ) + refVal = refObjVal; + else if( !(eValType & SbxARRAY) ) + refVal = NULL; + } + + // #52896 Wenn Uno-Sequences bzw. allgemein Arrays einer als + // Object deklarierten Variable zugewiesen werden, kann hier + // refVal ungueltig sein! + if( !refVal ) + { + Error( SbERR_INVALID_USAGE_OBJECT ); + } + else + { + // Store auf die eigene Methode (innerhalb einer Function)? + BOOL bFlagsChanged = FALSE; + USHORT n; + if( (SbxVariable*) refVar == (SbxVariable*) pMeth ) + { + bFlagsChanged = TRUE; + n = refVar->GetFlags(); + refVar->SetFlag( SBX_WRITE ); + } + *refVar = *refVal; + // #67607 Uno-Structs kopieren + checkUnoStructCopy( refVal, refVar ); + if( bFlagsChanged ) + refVar->SetFlags( n ); + } + } +} + +// JSM 07.10.95 +void SbiRuntime::StepLSET() +{ + SbxVariableRef refVal = PopVar(); + SbxVariableRef refVar = PopVar(); + if( refVar->GetType() != SbxSTRING + || refVal->GetType() != SbxSTRING ) + Error( SbERR_INVALID_USAGE_OBJECT ); + else + { + // Store auf die eigene Methode (innerhalb einer Function)? + USHORT n = refVar->GetFlags(); + if( (SbxVariable*) refVar == (SbxVariable*) pMeth ) + refVar->SetFlag( SBX_WRITE ); + String aRefVarString = refVar->GetString(); + String aRefValString = refVal->GetString(); + + if (aRefVarString.Len() > aRefValString.Len()) + aRefVarString.Fill(aRefVarString.Len(),' '); + aRefVarString = aRefValString.Copy( 0, aRefVarString.Len() ); + aRefVarString += aRefVarString.Copy( aRefValString.Len() ); + refVar->PutString(aRefVarString); + + refVar->SetFlags( n ); + } +} + +// JSM 07.10.95 +void SbiRuntime::StepRSET() +{ + SbxVariableRef refVal = PopVar(); + SbxVariableRef refVar = PopVar(); + if( refVar->GetType() != SbxSTRING + || refVal->GetType() != SbxSTRING ) + Error( SbERR_INVALID_USAGE_OBJECT ); + else + { + // Store auf die eigene Methode (innerhalb einer Function)? + USHORT n = refVar->GetFlags(); + if( (SbxVariable*) refVar == (SbxVariable*) pMeth ) + refVar->SetFlag( SBX_WRITE ); + String aRefVarString = refVar->GetString(); + String aRefValString = refVal->GetString(); + + USHORT nPos = 0; + if (aRefVarString.Len() > aRefValString.Len()) + { + aRefVarString.Fill(aRefVarString.Len(),' '); + nPos = aRefVarString.Len() - aRefValString.Len(); + } + aRefVarString = aRefVarString.Copy( 0, nPos ); + aRefVarString += aRefValString.Copy( 0, aRefVarString.Len() - nPos ); + refVar->PutString(aRefVarString); + + refVar->SetFlags( n ); + } +} + +// Ablage von TOS in TOS-1, dann ReadOnly-Bit setzen + +void SbiRuntime::StepPUTC() +{ + SbxVariableRef refVal = PopVar(); + SbxVariableRef refVar = PopVar(); + refVar->SetFlag( SBX_WRITE ); + *refVar = *refVal; + refVar->ResetFlag( SBX_WRITE ); + refVar->SetFlag( SBX_CONST ); +} + +// DIM +// TOS = Variable fuer das Array mit Dimensionsangaben als Parameter + +void SbiRuntime::StepDIM() +{ + SbxVariableRef refVar = PopVar(); + DimImpl( refVar ); +} + +// #56204 DIM-Funktionalitaet in Hilfsmethode auslagern (step0.cxx) +void SbiRuntime::DimImpl( SbxVariableRef refVar ) +{ + SbxArray* pDims = refVar->GetParameters(); + // Muss eine gerade Anzahl Argumente haben + // Man denke daran, dass Arg[0] nicht zaehlt! + if( pDims && !( pDims->Count() & 1 ) ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + { + SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT; + SbxDimArray* pArray = new SbxDimArray( eType ); + // AB 2.4.1996, auch Arrays ohne Dimensionsangaben zulassen (VB-komp.) + if( pDims ) + { + for( USHORT i = 1; i < pDims->Count(); ) + { + INT16 lb = pDims->Get( i++ )->GetInteger(); + INT16 ub = pDims->Get( i++ )->GetInteger(); + if( ub < lb ) + Error( SbERR_OUT_OF_RANGE ), ub = lb; + pArray->AddDim( lb, ub ); + } + } + else + { + // #62867 Beim Anlegen eines Arrays der Laenge 0 wie bei + // Uno-Sequences der Laenge 0 eine Dimension anlegen + pArray->unoAddDim( 0, -1 ); + } + USHORT nFlags = refVar->GetFlags(); + refVar->ResetFlag( SBX_FIXED ); + refVar->PutObject( pArray ); + refVar->SetFlags( nFlags ); + refVar->SetParameters( NULL ); + } +} + + +// REDIM +// TOS = Variable fuer das Array +// argv = Dimensionsangaben + +void SbiRuntime::StepREDIM() +{ + // Im Moment ist es nichts anderes als Dim, da doppeltes Dim + // bereits vom Compiler erkannt wird. + StepDIM(); +} + +// REDIM PRESERVE +// TOS = Variable fuer das Array +// argv = Dimensionsangaben + +void SbiRuntime::StepREDIMP() +{ + StarBASIC::FatalError( SbERR_NOT_IMPLEMENTED ); +} + +// Variable loeschen +// TOS = Variable + +void SbiRuntime::StepERASE() +{ + SbxVariableRef refVar = PopVar(); + SbxDataType eType = refVar->GetType(); + if( eType & SbxARRAY ) + { + // AB 2.4.1996 + // Arrays haben bei Erase nach VB ein recht komplexes Verhalten. Hier + // werden zunaechst nur die Typ-Probleme bei REDIM (#26295) beseitigt: + // Typ hart auf den Array-Typ setzen, da eine Variable mit Array + // SbxOBJECT ist. Bei REDIM entsteht dann ein SbxOBJECT-Array und + // der ursruengliche Typ geht verloren -> Laufzeitfehler + USHORT nFlags = refVar->GetFlags(); + refVar->ResetFlag( SBX_FIXED ); + refVar->SetType( SbxDataType(eType & 0x0FFF) ); + refVar->SetFlags( nFlags ); + refVar->Clear(); + } + else + if( refVar->IsFixed() ) + refVar->Clear(); + else + refVar->SetType( SbxEMPTY ); +} + +// Einrichten eines Argvs +// nOp1 bleibt so -> 1. Element ist Returnwert + +void SbiRuntime::StepARGC() +{ + PushArgv(); + refArgv = new SbxArray; + nArgc = 1; +} + +// Speichern eines Arguments in Argv + +void SbiRuntime::StepARGV() +{ + if( !refArgv ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + { + SbxVariableRef pVal = PopVar(); + if( pVal->ISA(SbxMethod) || pVal->ISA(SbxProperty) ) + { + // Methoden und Properties evaluieren! + SbxVariable* pRes = new SbxVariable( *pVal ); + pVal = pRes; + } + refArgv->Put( pVal, nArgc++ ); + } +} + +// Input to Variable. Die Variable ist auf TOS und wird +// anschliessend entfernt. + +void SbiRuntime::StepINPUT() +{ + String s; + char ch; + SbError err; + // Skip whitespace + while( ( err = pIosys->GetError() ) == 0 ) + { + ch = pIosys->Read(); + if( ch != ' ' && ch != '\t' && ch != '\n' ) + break; + } + if( !err ) + { + // Scan until comma or whitespace + char sep = ( ch == '"' ) ? ch : 0; + if( sep ) ch = pIosys->Read(); + while( ( err = pIosys->GetError() ) == 0 ) + { + if( ch == sep ) + { + ch = pIosys->Read(); + if( ch != sep ) + break; + } + else if( !sep && (ch == ',' || ch == '\n') ) + break; + s += ch; + ch = pIosys->Read(); + } + // skip whitespace + if( ch == ' ' || ch == '\t' ) + while( ( err = pIosys->GetError() ) == 0 ) + { + if( ch != ' ' && ch != '\t' && ch != '\n' ) + break; + ch = pIosys->Read(); + } + } + if( !err ) + { + SbxVariableRef pVar = GetTOS(); + // Zuerst versuchen, die Variable mit einem numerischen Wert + // zu fuellen, dann mit einem Stringwert + BOOL bSet = FALSE; + if( !pVar->IsFixed() || pVar->IsNumeric() ) + { + USHORT nLen = 0; + if( !pVar->Scan( s, &nLen ) ) + { + err = SbxBase::GetError(); + SbxBase::ResetError(); + } + // Der Wert muss komplett eingescant werden + else if( nLen != s.Len() && !pVar->PutString( s ) ) + { + err = SbxBase::GetError(); + SbxBase::ResetError(); + } + else if( nLen != s.Len() && pVar->IsNumeric() ) + { + err = SbxBase::GetError(); + SbxBase::ResetError(); + if( !err ) + err = SbERR_CONVERSION; + } + } + else + { + pVar->PutString( s ); + err = SbxBase::GetError(); + SbxBase::ResetError(); + } + } + if( err == SbERR_USER_ABORT ) + Error( err ); + else if( err ) + { + if( pRestart && !pIosys->GetChannel() ) + { + BasicResId aId( IDS_SBERR_START + 4 ); + String aMsg( aId ); + ErrorBox( NULL, WB_OK, aMsg ).Execute(); + pCode = pRestart; + } + else + Error( err ); + } + else + { + // pIosys->ResetChannel(); + PopVar(); + } +} + +// Line Input to Variable. Die Variable ist auf TOS und wird +// anschliessend entfernt. + +void SbiRuntime::StepLINPUT() +{ + ByteString aInput; + pIosys->Read( aInput ); + Error( pIosys->GetError() ); + SbxVariableRef p = PopVar(); + p->PutString( String( aInput, gsl_getSystemTextEncoding() ) ); + // pIosys->ResetChannel(); +} + +// Programmende + +void SbiRuntime::StepSTOP() +{ + pInst->Stop(); +} + +// FOR-Variable initialisieren + +void SbiRuntime::StepINITFOR() +{ + PushFor(); +} + +// FOR-Variable inkrementieren + +void SbiRuntime::StepNEXT() +{ + if( !pForStk ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc ); +} + +// Anfang CASE: TOS in CASE-Stack + +void SbiRuntime::StepCASE() +{ + if( !refCaseStk.Is() ) + refCaseStk = new SbxArray; + SbxVariableRef xVar = PopVar(); + refCaseStk->Put( xVar, refCaseStk->Count() ); +} + +// Ende CASE: Variable freigeben + +void SbiRuntime::StepENDCASE() +{ + if( !refCaseStk || !refCaseStk->Count() ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + refCaseStk->Remove( refCaseStk->Count() - 1 ); +} + +// Standard-Fehlerbehandlung + +void SbiRuntime::StepSTDERROR() +{ + pError = NULL; bError = TRUE; + pInst->aErrorMsg = String(); + pInst->nErr = 0L; + pInst->nErl = 0; + nError = 0L; +} + +void SbiRuntime::StepNOERROR() +{ + pInst->aErrorMsg = String(); + pInst->nErr = 0L; + pInst->nErl = 0; + nError = 0L; + bError = FALSE; +} + +// UP verlassen + +void SbiRuntime::StepLEAVE() +{ + bRun = FALSE; +} + +void SbiRuntime::StepCHANNEL() // TOS = Kanalnummer +{ + SbxVariableRef pChan = PopVar(); + short nChan = pChan->GetInteger(); + pIosys->SetChannel( nChan ); + Error( pIosys->GetError() ); +} + +void SbiRuntime::StepCHANNEL0() +{ + pIosys->ResetChannel(); +} + +void SbiRuntime::StepPRINT() // print TOS +{ + SbxVariableRef p = PopVar(); + String s1 = p->GetString(); + String s; + if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE ) + s = ' '; // ein Blank davor + s += s1; + ByteString aByteStr( s, gsl_getSystemTextEncoding() ); + pIosys->Write( aByteStr ); + Error( pIosys->GetError() ); +} + +void SbiRuntime::StepPRINTF() // print TOS in field +{ + SbxVariableRef p = PopVar(); + String s1 = p->GetString(); + String s; + if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE ) + s = ' '; // ein Blank davor + s += s1; + s.Expand( 14, ' ' ); + ByteString aByteStr( s, gsl_getSystemTextEncoding() ); + pIosys->Write( aByteStr ); + Error( pIosys->GetError() ); +} + +void SbiRuntime::StepWRITE() // write TOS +{ + SbxVariableRef p = PopVar(); + // Muss der String gekapselt werden? + char ch = 0; + switch (p->GetType() ) + { + case SbxSTRING: ch = '"'; break; + case SbxCURRENCY: + case SbxBOOL: + case SbxDATE: ch = '#'; break; + } + String s; + if( ch ) + s += ch; + s += p->GetString(); + if( ch ) + s += ch; + ByteString aByteStr( s, gsl_getSystemTextEncoding() ); + pIosys->Write( aByteStr ); + Error( pIosys->GetError() ); +} + +void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos +{ + SbxVariableRef pTos1 = PopVar(); + SbxVariableRef pTos = PopVar(); + String aDest = pTos1->GetString(); + String aSource = pTos->GetString(); + + // <-- UCB + if( hasUno() ) + { + implStepRenameUCB( aSource, aDest ); + } + else + // --> UCB + { + DirEntry aSourceDirEntry( aSource ); + if( aSourceDirEntry.Exists() ) + { + if( aSourceDirEntry.MoveTo( DirEntry(aDest) ) != FSYS_ERR_OK ) + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } + else + StarBASIC::Error( SbERR_PATH_NOT_FOUND ); + } +} + +// TOS = Prompt + +void SbiRuntime::StepPROMPT() +{ + SbxVariableRef p = PopVar(); + ByteString aStr( p->GetString(), gsl_getSystemTextEncoding() ); + pIosys->SetPrompt( aStr ); +} + +// Set Restart point + +void SbiRuntime::StepRESTART() +{ + pRestart = pCode; +} + +// Leerer Ausdruck auf Stack fuer fehlenden Parameter + +void SbiRuntime::StepEMPTY() +{ + // #57915 Die Semantik von StepEMPTY() ist die Repraesentation eines fehlenden + // Arguments. Dies wird in VB durch ein durch den Wert 448 (SbERR_NAMED_NOT_FOUND) + // vom Typ Error repraesentiert. StepEmpty jetzt muesste besser StepMISSING() + // heissen, aber der Name wird der Einfachkeit halber beibehalten. + SbxVariableRef xVar = new SbxVariable( SbxVARIANT ); + xVar->PutErr( 448 ); + PushVar( xVar ); + // ALT: PushVar( new SbxVariable( SbxEMPTY ) ); +} + +// TOS = Fehlercode + +void SbiRuntime::StepERROR() +{ + SbxVariableRef refCode = PopVar(); + ULONG n = refCode->GetLong(); + Error( n ); +} + diff --git a/basic/source/runtime/step1.cxx b/basic/source/runtime/step1.cxx new file mode 100644 index 000000000000..9196e5df0fa0 --- /dev/null +++ b/basic/source/runtime/step1.cxx @@ -0,0 +1,423 @@ +/************************************************************************* + * + * $RCSfile: step1.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#include <stdlib.h> +#include <svtools/sbx.hxx> +#ifndef _TOOLS_SOLMATH_HXX //autogen wg. SolarMath +#include <tools/solmath.hxx> +#endif +#ifndef _TOOLS_INTN_HXX //autogen wg. International +#include <tools/intn.hxx> +#endif +#include "runtime.hxx" +#pragma hdrstop +#include "sbintern.hxx" +#include "iosys.hxx" +#include "image.hxx" + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + +// Laden einer numerischen Konstanten (+ID) + +void SbiRuntime::StepLOADNC( USHORT nOp1 ) +{ + static International aEnglischIntn( LANGUAGE_ENGLISH_US, LANGUAGE_ENGLISH_US ); + + SbxVariable* p = new SbxVariable( SbxDOUBLE ); + + // #57844 Lokalisierte Funktion benutzen + int nErrno; + String aStr = pImg->GetString( nOp1 ); + // Auch , zulassen !!! + USHORT iComma = aStr.Search( ',' ); + if( iComma != STRING_NOTFOUND ) + { + String aStr1 = aStr.Copy( 0, iComma ); + String aStr2 = aStr.Copy( iComma + 1 ); + aStr = aStr1; + aStr += '.'; + aStr += aStr2; + } + double n = SolarMath::StringToDouble( aStr.GetBuffer(), aEnglischIntn, nErrno ); + //ALT: double n = atof( pImg->GetString( nOp1 ) ); + + p->PutDouble( n ); + PushVar( p ); +} + +// Laden einer Stringkonstanten (+ID) + +void SbiRuntime::StepLOADSC( USHORT nOp1 ) +{ + SbxVariable* p = new SbxVariable; + p->PutString( pImg->GetString( nOp1 ) ); + PushVar( p ); +} + +// Immediate Load (+Wert) + +void SbiRuntime::StepLOADI( USHORT nOp1 ) +{ + SbxVariable* p = new SbxVariable; + p->PutInteger( nOp1 ); + PushVar( p ); +} + +// Speichern eines named Arguments in Argv (+Arg-Nr ab 1!) + +void SbiRuntime::StepARGN( USHORT nOp1 ) +{ + if( !refArgv ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + { + String aAlias( pImg->GetString( nOp1 ) ); + SbxVariableRef pVal = PopVar(); + refArgv->Put( pVal, nArgc ); + refArgv->PutAlias( aAlias, nArgc++ ); + } +} + +// Konvertierung des Typs eines Arguments in Argv fuer DECLARE-Fkt. (+Typ) + +void SbiRuntime::StepARGTYP( USHORT nOp1 ) +{ + if( !refArgv ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + { + BOOL bByVal = (nOp1 & 0x8000) != 0; // Ist BYVAL verlangt? + SbxDataType t = (SbxDataType) (nOp1 & 0x7FFF); + SbxVariable* pVar = refArgv->Get( refArgv->Count() - 1 ); // letztes Arg + + // BYVAL prüfen + if( pVar->GetRefCount() > 2 ) // 2 ist normal für BYVAL + { + // Parameter ist eine Referenz + if( bByVal ) + { + // Call by Value ist verlangt -> Kopie anlegen + pVar = new SbxVariable( *pVar ); + pVar->SetFlag( SBX_READWRITE ); + refExprStk->Put( pVar, refArgv->Count() - 1 ); + } + else + pVar->SetFlag( SBX_REFERENCE ); // Ref-Flag für DllMgr + } + else + { + // Parameter ist KEINE Referenz + if( bByVal ) + pVar->ResetFlag( SBX_REFERENCE ); // Keine Referenz -> OK + else + Error( SbERR_BAD_PARAMETERS ); // Referenz verlangt + } + + if( pVar->GetType() != t ) + { + // Variant, damit richtige Konvertierung + // Ausserdem Fehler, wenn SbxBYREF + pVar->Convert( SbxVARIANT ); + pVar->Convert( t ); + } + } +} + +// String auf feste Laenge bringen (+Laenge) + +void SbiRuntime::StepPAD( USHORT nOp1 ) +{ + SbxVariable* p = GetTOS(); + String& s = (String&)(const String&) *p; + if( s.Len() > nOp1 ) + s.Erase( nOp1 ); + else + s.Expand( nOp1, ' ' ); +} + +// Sprung (+Target) + +void SbiRuntime::StepJUMP( USHORT nOp1 ) +{ +#ifndef PRODUCT + if( nOp1 >= pImg->GetCodeSize() ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); +#endif + pCode = (const BYTE*) pImg->GetCode() + nOp1; +} + +// TOS auswerten, bedingter Sprung (+Target) + +void SbiRuntime::StepJUMPT( USHORT nOp1 ) +{ + SbxVariableRef p = PopVar(); + if( p->GetBool() ) + StepJUMP( nOp1 ); +} + +// TOS auswerten, bedingter Sprung (+Target) + +void SbiRuntime::StepJUMPF( USHORT nOp1 ) +{ + SbxVariableRef p = PopVar(); + if( !p->GetBool() ) + StepJUMP( nOp1 ); +} + +// TOS auswerten, Sprung in JUMP-Tabelle (+MaxVal) +// Sieht so aus: +// ONJUMP 2 +// JUMP target1 +// JUMP target2 +// ... +//Falls im Operanden 0x8000 gesetzt ist, Returnadresse pushen (ON..GOSUB) + +void SbiRuntime::StepONJUMP( USHORT nOp1 ) +{ + SbxVariableRef p = PopVar(); + INT16 n = p->GetInteger(); + if( nOp1 & 0x8000 ) + { + nOp1 &= 0x7FFF; + PushGosub( pCode + 3 * nOp1 ); + } + if( n < 1 || n > (short) nOp1 ) + n = nOp1 + 1; + nOp1 = (USHORT) ( (const char*) pCode - pImg->GetCode() ) + 3 * --n; + StepJUMP( nOp1 ); +} + +// UP-Aufruf (+Target) + +void SbiRuntime::StepGOSUB( USHORT nOp1 ) +{ + PushGosub( pCode ); + if( nOp1 >= pImg->GetCodeSize() ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + pCode = (const BYTE*) pImg->GetCode() + nOp1; +} + +// UP-Return (+0 oder Target) + +void SbiRuntime::StepRETURN( USHORT nOp1 ) +{ + PopGosub(); + if( nOp1 ) + StepJUMP( nOp1 ); +} + +// FOR-Variable testen (+Endlabel) + +void SbiRuntime::StepTESTFOR( USHORT nOp1 ) +{ + if( !pForStk ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + { + SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT; + if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) ) + { + PopFor(); + StepJUMP( nOp1 ); + } + } +} + +// Tos+1 <= Tos+2 <= Tos, 2xremove (+Target) + +void SbiRuntime::StepCASETO( USHORT nOp1 ) +{ + if( !refCaseStk || !refCaseStk->Count() ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + { + SbxVariableRef xTo = PopVar(); + SbxVariableRef xFrom = PopVar(); + SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 ); + if( *xCase >= *xFrom && *xCase <= *xTo ) + StepJUMP( nOp1 ); + } +} + +// Fehler-Handler + +void SbiRuntime::StepERRHDL( USHORT nOp1 ) +{ + const BYTE* p = pCode; + StepJUMP( nOp1 ); + pError = pCode; + pCode = p; + pInst->aErrorMsg = String(); + pInst->nErr = + pInst->nErl = + nError = 0; +} + +// Resume nach Fehlern (+0=statement, 1=next or Label) + +void SbiRuntime::StepRESUME( USHORT nOp1 ) +{ + // AB #32714 Resume ohne Error? -> Fehler + if( !bInError ) + { + Error( SbERR_BAD_RESUME ); + return; + } + if( nOp1 ) + { + // Code-Zeiger auf naechstes Statement setzen + USHORT n1, n2; + pCode = pMod->FindNextStmnt( pErrCode, n1, n2 ); + } + else + pCode = pErrStmnt; + + if( nOp1 > 1 ) + StepJUMP( nOp1 ); + pInst->aErrorMsg = String(); + pInst->nErr = + pInst->nErl = + nError = 0; + bInError = FALSE; + + // Error-Stack loeschen + SbErrorStack*& rErrStack = GetSbData()->pErrStack; + delete rErrStack; + rErrStack = NULL; +} + +// Kanal schliessen (+Kanal, 0=Alle) +void SbiRuntime::StepCLOSE( USHORT nOp1 ) +{ + short err; + if( !nOp1 ) + pIosys->Shutdown(); + else + { + err = pIosys->GetError(); + if( !err ) + { + pIosys->Close(); + } + } + err = pIosys->GetError(); + Error( err ); +} + +// Zeichen ausgeben (+char) + +void SbiRuntime::StepPRCHAR( USHORT nOp1 ) +{ + ByteString s( (char) nOp1 ); + pIosys->Write( s ); + Error( pIosys->GetError() ); +} + +// Check, ob TOS eine bestimmte Objektklasse ist (+StringID) + +void SbiRuntime::StepCLASS( USHORT nOp1 ) +{ + String aClass( pImg->GetString( nOp1 ) ); + SbxVariable* pVar = GetTOS(); + if( pVar->GetType() != SbxOBJECT ) + Error( SbERR_NEEDS_OBJECT ); + else + { + SbxObject* pObj; + if( pVar->IsA( TYPE(SbxObject) ) ) + pObj = (SbxObject*) pVar; + else + { + pObj = (SbxObject*) pVar->GetObject(); + if( pObj && !pObj->IsA( TYPE(SbxObject) ) ) + pObj = NULL; + } + if( !pObj || !pObj->IsClass( aClass ) ) + Error( SbERR_INVALID_USAGE_OBJECT ); + } +} + +// Library fuer anschliessenden Declare-Call definieren + +void SbiRuntime::StepLIB( USHORT nOp1 ) +{ + aLibName = pImg->GetString( nOp1 ); +} + +// TOS wird um BASE erhoeht, BASE davor gepusht (+BASE) +// Dieser Opcode wird vor DIM/REDIM-Anweisungen gepusht, +// wenn nur ein Index angegeben wurde. + +void SbiRuntime::StepBASED( USHORT nOp1 ) +{ + SbxVariable* p1 = new SbxVariable; + SbxVariableRef x2 = PopVar(); + p1->PutInteger( nOp1 ); + x2->Compute( SbxPLUS, *p1 ); + PushVar( x2 ); // erst die Expr + PushVar( p1 ); // dann die Base +} + + + + + diff --git a/basic/source/runtime/step2.cxx b/basic/source/runtime/step2.cxx new file mode 100644 index 000000000000..34e03c96045c --- /dev/null +++ b/basic/source/runtime/step2.cxx @@ -0,0 +1,960 @@ +/************************************************************************* + * + * $RCSfile: step2.cxx,v $ + * + * $Revision: 1.1.1.1 $ + * + * last change: $Author: hr $ $Date: 2000-09-18 16:12:11 $ + * + * The Contents of this file are made available subject to the terms of + * either of the following licenses + * + * - GNU Lesser General Public License Version 2.1 + * - Sun Industry Standards Source License Version 1.1 + * + * Sun Microsystems Inc., October, 2000 + * + * GNU Lesser General Public License Version 2.1 + * ============================================= + * Copyright 2000 by Sun Microsystems, Inc. + * 901 San Antonio Road, Palo Alto, CA 94303, USA + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License version 2.1, as published by the Free Software Foundation. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, + * MA 02111-1307 USA + * + * + * Sun Industry Standards Source License Version 1.1 + * ================================================= + * The contents of this file are subject to the Sun Industry Standards + * Source License Version 1.1 (the "License"); You may not use this file + * except in compliance with the License. You may obtain a copy of the + * License at http://www.openoffice.org/license.html. + * + * Software provided under this License is provided on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + * WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS, + * MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING. + * See the License for the specific provisions governing your rights and + * obligations concerning the Software. + * + * The Initial Developer of the Original Code is: Sun Microsystems, Inc. + * + * Copyright: 2000 by Sun Microsystems, Inc. + * + * All Rights Reserved. + * + * Contributor(s): _______________________________________ + * + * + ************************************************************************/ + +#include <svtools/sbxdef.hxx> +#include <svtools/sbx.hxx> +#include "runtime.hxx" +#pragma hdrstop +#include "iosys.hxx" +#include "image.hxx" +#include "sbintern.hxx" +#include "sbunoobj.hxx" +#include "opcodes.hxx" + +#include <com/sun/star/container/XIndexAccess.hpp> +#include <com/sun/star/uno/Any.hxx> + +using namespace com::sun::star::container; +using namespace com::sun::star::lang; + + +#include "segmentc.hxx" +#pragma SW_SEGMENT_CLASS( SBRUNTIME, SBRUNTIME_CODE ) + + +/* +// #72488 Spezielle SbxVariable, die beim get das Verhalten +// einer nicht initialisierten Variable simuliert. Wenn als +// Typ SbxOBJECT verlangt wird, geht das jedoch nicht. +class UnoClassSbxVariable : public SbxVariable +{ + SbxDataType eOrgType; + BOOL bOverWritten; + const SbiImage* mpImg; + SbiRuntime* mpRuntime; + +public: + UnoClassSbxVariable( SbxDataType eType, const SbiImage* pImg_, SbiRuntime* pRuntime_ ) + : SbxVariable( SbxVARIANT ), mpImg( pImg_ ), mpRuntime( pRuntime_ ) + { + eOrgType = eType; + bOverWritten = FALSE; + } + + virtual BOOL Get( SbxValues& ) const; + virtual BOOL Put( const SbxValues& ); +}; +*/ + +BOOL UnoClassSbxVariable::Get( SbxValues& rRes ) const +{ + static SbxVariable* pDummy = new SbxVariable( SbxVARIANT ); + if( mbOverWritten || rRes.eType == SbxOBJECT || rRes.eType == SbxVARIANT ) + { + return SbxVariable::Get( rRes ); + } + if( mpImg->GetFlag( SBIMG_EXPLICIT ) ) + { + mpRuntime->Error( SbERR_VAR_UNDEFINED ); + return FALSE; + } + return pDummy->Get( rRes ); +} + +BOOL UnoClassSbxVariable::Put( const SbxValues& rRes ) +{ + // Sonst, falls keine Parameter sind, anderen Error Code verwenden + if( !mbOverWritten ) + { + if( mpImg->GetFlag( SBIMG_EXPLICIT ) ) + { + mpRuntime->Error( SbERR_VAR_UNDEFINED ); + return FALSE; + } + mbOverWritten = TRUE; + + SetType( meOrgType ); + if( meOrgType != SbxVARIANT ) + SetFlag( SBX_FIXED ); + } + return SbxVariable::Put( rRes ); +} + +TYPEINIT1(UnoClassSbxVariable,SbxVariable) + + +// Suchen eines Elements +// Die Bits im String-ID: +// 0x8000 - Argv ist belegt + +SbxVariable* SbiRuntime::FindElement + ( SbxObject* pObj, USHORT nOp1, USHORT nOp2, SbError nNotFound, BOOL bLocal ) +{ + SbxVariable* pElem = NULL; + if( !pObj ) + { + Error( SbERR_NO_OBJECT ); + pElem = new SbxVariable; + } + else + { + BOOL bFatalError = FALSE; + SbxDataType t = (SbxDataType) nOp2; + String aName( pImg->GetString( nOp1 & 0x7FFF ) ); + if( bLocal ) + pElem = refLocals->Find( aName, SbxCLASS_DONTCARE ); + if( !pElem ) + { + // Die RTL brauchen wir nicht mehr zu durchsuchen! + BOOL bSave = rBasic.bNoRtl; + rBasic.bNoRtl = TRUE; + pElem = pObj->Find( aName, SbxCLASS_DONTCARE ); + rBasic.bNoRtl = bSave; + + // Ist es ein globaler Uno-Bezeichner? + if( bLocal && !pElem ) + { + // #72382 VORSICHT! Liefert jetzt wegen unbekannten + // Modulen IMMER ein Ergebnis! + SbxVariable* pUnoClass = findUnoClass( aName ); + pElem = new UnoClassSbxVariable( t, pImg, this ); + SbxValues aRes( SbxOBJECT ); + aRes.pObj = pUnoClass; + pElem->SbxVariable::Put( aRes ); + //pElem->SbxVariable::PutObject( pUnoClass ); + + // #62939 Wenn eine Uno-Klasse gefunden wurde, muss + // das Wrapper-Objekt gehalten werden, da sonst auch + // die Uno-Klasse, z.B. "stardiv" immer wieder neu + // aus der Registry gelesen werden muss + //if( pElem ) + //{ + // #63774 Darf nicht mit gespeichert werden!!! + pElem->SetFlag( SBX_DONTSTORE ); + pElem->SetFlag( SBX_NO_MODIFY); + + // #72382 Lokal speichern, sonst werden alle implizit + // deklarierten Vars automatisch global ! + pElem->SetName( aName ); + refLocals->Put( pElem, refLocals->Count() ); + // OLD: rBasic.Insert( pElem ); + //} + } + + if( !pElem ) + { + // Nicht da und nicht im Objekt? + // Hat das Ding Parameter, nicht einrichten! + if( nOp1 & 0x8000 ) + bFatalError = TRUE; + // ALT: StarBASIC::FatalError( nNotFound ); + + // Sonst, falls keine Parameter sind, anderen Error Code verwenden + if( !bLocal || pImg->GetFlag( SBIMG_EXPLICIT ) ) + { + // #39108 Bei explizit und als ELEM immer ein Fatal Error + bFatalError = TRUE; + + // Falls keine Parameter sind, anderen Error Code verwenden + if( !( nOp1 & 0x8000 ) && nNotFound == SbERR_PROC_UNDEFINED ) + nNotFound = SbERR_VAR_UNDEFINED; + } + if( bFatalError ) + { + // #39108 Statt FatalError zu setzen, Dummy-Variable liefern + if( !xDummyVar.Is() ) + xDummyVar = new SbxVariable( SbxVARIANT ); + pElem = xDummyVar; + + // Parameter von Hand loeschen + ClearArgvStack(); + + // Normalen Error setzen + Error( nNotFound ); + } + else + { + // Sonst Variable neu anlegen + pElem = new SbxVariable( t ); + if( t != SbxVARIANT ) + pElem->SetFlag( SBX_FIXED ); + pElem->SetName( aName ); + refLocals->Put( pElem, refLocals->Count() ); + } + } + } + // #39108 Args koennen schon geloescht sein! + if( !bFatalError ) + SetupArgs( pElem, nOp1 ); + // Ein bestimmter Call-Type wurde gewuenscht, daher muessen + // wir hier den Typ setzen und das Ding anfassen, um den + // korrekten Returnwert zu erhalten! + if( pElem->IsA( TYPE(SbxMethod) ) ) + { + // Soll der Typ konvertiert werden? + SbxDataType t2 = pElem->GetType(); + BOOL bSet = FALSE; + if( !( pElem->GetFlags() & SBX_FIXED ) ) + { + if( t != SbxVARIANT && t != t2 && + t >= SbxINTEGER && t <= SbxSTRING ) + pElem->SetType( t ), bSet = TRUE; + } + // pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen + SbxVariableRef refTemp = pElem; + + // Moegliche Reste vom letzten Aufruf der SbxMethod beseitigen + // Vorher Schreiben freigeben, damit kein Error gesetzt wird. + USHORT nFlags = pElem->GetFlags(); + pElem->SetFlag( SBX_READWRITE | SBX_NO_BROADCAST ); + pElem->SbxValue::Clear(); + pElem->SetFlags( nFlags ); + + // Erst nach dem Setzen anfassen, da z.B. LEFT() + // den Unterschied zwischen Left$() und Left() kennen muss + + // AB 12.8.96: Da in PopVar() die Parameter von Methoden weggehauen + // werden, muessen wir hier explizit eine neue SbxMethod anlegen + SbxVariable* pNew = new SbxMethod( *((SbxMethod*)pElem) ); // das ist der Call! + //ALT: SbxVariable* pNew = new SbxVariable( *pElem ); // das ist der Call! + + pElem->SetParameters(0); // sonst bleibt Ref auf sich selbst + pNew->SetFlag( SBX_READWRITE ); + + // den Datentypen zuruecksetzen? + if( bSet ) + pElem->SetType( t2 ); + pElem = pNew; + } + // Index-Access bei UnoObjekten beruecksichtigen + /* + else if( pElem->ISA(SbUnoProperty) ) + { + // pElem auf eine Ref zuweisen, um ggf. eine Temp-Var zu loeschen + SbxVariableRef refTemp = pElem; + + // Variable kopieren und dabei den Notify aufloesen + SbxVariable* pNew = new SbxVariable( *((SbxVariable*)pElem) ); // das ist der Call! + pElem->SetParameters( NULL ); // sonst bleibt Ref auf sich selbst + pElem = pNew; + } + */ + } + return CheckArray( pElem ); +} + +// Find-Funktion ueber Name fuer aktuellen Scope (z.B. Abfrage aus BASIC-IDE) +SbxBase* SbiRuntime::FindElementExtern( const String& rName ) +{ + // Hinweis zu #35281#: Es darf nicht davon ausgegangen werden, dass + // pMeth != null, da im RunInit noch keine gesetzt ist. + + SbxVariable* pElem = NULL; + if( !pMod || !rName.Len() ) + return NULL; + + // Lokal suchen + if( refLocals ) + pElem = refLocals->Find( rName, SbxCLASS_DONTCARE ); + + // In Statics suchen + if ( !pElem && pMeth ) + { + // Bei Statics, Name der Methode davor setzen + String aMethName = pMeth->GetName(); + aMethName += ':'; + aMethName += rName; + pElem = pMod->Find(aMethName, SbxCLASS_DONTCARE); + } + + // In Parameter-Liste suchen + if( !pElem && pMeth ) + { + SbxInfo* pInfo = pMeth->GetInfo(); + if( pInfo && refParams ) + { + USHORT j = 1; + const SbxParamInfo* pParam = pInfo->GetParam( j ); + while( pParam ) + { + if( pParam->aName.EqualsIgnoreCaseAscii( rName ) ) + { + pElem = refParams->Get( j ); + break; + } + pParam = pInfo->GetParam( ++j ); + } + } + } + + // Im Modul suchen + if( !pElem ) + { + // RTL nicht durchsuchen! + BOOL bSave = rBasic.bNoRtl; + rBasic.bNoRtl = TRUE; + pElem = pMod->Find( rName, SbxCLASS_DONTCARE ); + rBasic.bNoRtl = bSave; + } + return pElem; +} + + +// Argumente eines Elements setzen +// Dabei auch die Argumente umsetzen, falls benannte Parameter +// verwendet wurden + +void SbiRuntime::SetupArgs( SbxVariable* p, USHORT nOp1 ) +{ + if( nOp1 & 0x8000 ) + { + if( !refArgv ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + BOOL bHasNamed = FALSE; + USHORT i; + for( i = 1; i < refArgv->Count(); i++ ) + { + if( refArgv->GetAlias( i ).Len() ) + { + bHasNamed = TRUE; break; + } + } + if( bHasNamed ) + { + // Wir haben mindestens einen benannten Parameter! + // Wir muessen also umsortieren + // Gibt es Parameter-Infos? + SbxInfo* pInfo = p->GetInfo(); + if( !pInfo ) + Error( SbERR_NO_NAMED_ARGS ); + else + { + USHORT nCurPar = 1; + SbxArray* pArg = new SbxArray; + for( i = 1; i < refArgv->Count(); i++ ) + { + SbxVariable* pVar = refArgv->Get( i ); + const String& rName = refArgv->GetAlias( i ); + if( rName.Len() ) + { + // nCurPar wird auf den gefundenen Parameter gesetzt + USHORT j = 1; + const SbxParamInfo* pParam = pInfo->GetParam( j ); + while( pParam ) + { + if( pParam->aName.EqualsIgnoreCaseAscii( rName ) ) + { + nCurPar = j; + break; + } + pParam = pInfo->GetParam( ++j ); + } + if( !pParam ) + { + Error( SbERR_NAMED_NOT_FOUND ); break; + } + } + pArg->Put( pVar, nCurPar++ ); + } + refArgv = pArg; + } + } + // Eigene Var als Parameter 0 + refArgv->Put( p, 0 ); + p->SetParameters( refArgv ); + PopArgv(); + } + else + p->SetParameters( NULL ); +} + +// Holen eines Array-Elements + +SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem ) +{ + // Falls wir ein Array haben, wollen wir bitte das Array-Element! + SbxArray* pPar; + if( pElem->GetType() & SbxARRAY ) + { + SbxBase* pElemObj = pElem->GetObject(); + SbxDimArray* pDimArray = PTR_CAST(SbxDimArray,pElemObj); + pPar = pElem->GetParameters(); + if( pDimArray ) + { + // Die Parameter koennen fehlen, wenn ein Array als + // Argument uebergeben wird. + if( pPar ) + pElem = pDimArray->Get( pPar ); + } + else + { + SbxArray* pArray = PTR_CAST(SbxArray,pElemObj); + if( pArray ) + { + if( !pPar ) + { + Error( SbERR_OUT_OF_RANGE ); + pElem = new SbxVariable; + } + else + pElem = pArray->Get( pPar->Get( 1 )->GetInteger() ); + } + } + + // #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt + if( pPar ) + pPar->Put( NULL, 0 ); + } + // Index-Access bei UnoObjekten beruecksichtigen + else if( pElem->GetType() == SbxOBJECT && !pElem->ISA(SbxMethod) && (pPar = pElem->GetParameters()) ) + { + // Ist es ein Uno-Objekt? + SbxBaseRef pObj = (SbxBase*)pElem->GetObject(); + if( pObj && pObj->ISA(SbUnoObject) ) + { + SbUnoObject* pUnoObj = (SbUnoObject*)(SbxBase*)pObj; + Any aAny = pUnoObj->getUnoAny(); + + if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE ) + { + Reference< XInterface > x = *(Reference< XInterface >*)aAny.getValue(); + Reference< XIndexAccess > xIndexAccess( x, UNO_QUERY ); + + // Haben wir Index-Access? + if( xIndexAccess.is() ) + { + UINT32 nParamCount = (UINT32)pPar->Count() - 1; + if( nParamCount != 1 ) + { + StarBASIC::Error( SbERR_BAD_ARGUMENT ); + return pElem; + } + + // Index holen + INT32 nIndex = pPar->Get( 1 )->GetLong(); + Reference< XInterface > xRet; + try + { + Any aAny = xIndexAccess->getByIndex( nIndex ); + TypeClass eType = aAny.getValueType().getTypeClass(); + if( eType == TypeClass_INTERFACE ) + xRet = *(Reference< XInterface >*)aAny.getValue(); + } + catch (IndexOutOfBoundsException& e1) + { + // Bei Exception erstmal immer von Konvertierungs-Problem ausgehen + StarBASIC::Error( SbERR_OUT_OF_RANGE ); + } + + // #57847 Immer neue Variable anlegen, sonst Fehler + // durch PutObject(NULL) bei ReadOnly-Properties. + pElem = new SbxVariable( SbxVARIANT ); + if( xRet.is() ) + { + aAny <<= xRet; + + // #67173 Kein Namen angeben, damit echter Klassen-Namen eintragen wird + String aName; + SbxObjectRef xWrapper = (SbxObject*)new SbUnoObject( aName, aAny ); + pElem->PutObject( xWrapper ); + } + else + { + pElem->PutObject( NULL ); + } + } + } + } + + // #42940, 0.Parameter zu NULL setzen, damit sich Var nicht selbst haelt + if( pPar ) + pPar->Put( NULL, 0 ); + } + + return pElem; +} + +// Laden eines Elements aus der Runtime-Library (+StringID+Typ) + +void SbiRuntime::StepRTL( USHORT nOp1, USHORT nOp2 ) +{ + PushVar( FindElement( rBasic.pRtl, nOp1, nOp2, SbERR_PROC_UNDEFINED, FALSE ) ); +} + +// Laden einer lokalen/globalen Variablen (+StringID+Typ) + +void SbiRuntime::StepFIND( USHORT nOp1, USHORT nOp2 ) +{ + if( !refLocals ) + refLocals = new SbxArray; + PushVar( FindElement( pMod, nOp1, nOp2, SbERR_PROC_UNDEFINED, TRUE ) ); +} + +// Laden eines Objekt-Elements (+StringID+Typ) +// Das Objekt liegt auf TOS + +void SbiRuntime::StepELEM( USHORT nOp1, USHORT nOp2 ) +{ + // Liegt auf dem TOS ein Objekt? + SbxVariableRef pObjVar = PopVar(); + + SbxObject* pObj = PTR_CAST(SbxObject,(SbxVariable*) pObjVar); + if( !pObj ) + { + SbxBase* pObjVarObj = pObjVar->GetObject(); + pObj = PTR_CAST(SbxObject,pObjVarObj); + } + + // #56368 Bei StepElem Referenz sichern, sonst koennen Objekte + // in Qualifizierungsketten wie ActiveComponent.Selection(0).Text + // zu fueh die Referenz verlieren + // #74254 Jetzt per Liste + if( pObj ) + SaveRef( (SbxVariable*)pObj ); + + PushVar( FindElement( pObj, nOp1, nOp2, SbERR_NO_METHOD, FALSE ) ); +} + +// Laden eines Parameters (+Offset+Typ) +// Wenn der Datentyp nicht stimmen sollte, eine Kopie anlegen +// Der Datentyp SbxEMPTY zeigt an, daá kein Parameter angegeben ist. +// Get( 0 ) darf EMPTY sein + +void SbiRuntime::StepPARAM( USHORT nOp1, USHORT nOp2 ) +{ + USHORT i = nOp1 & 0x7FFF; + SbxDataType t = (SbxDataType) nOp2; + SbxVariable* p; + + // #57915 Missing sauberer loesen + BOOL bIsMissing = FALSE; + USHORT nParamCount = refParams->Count(); + // Wurden ueberhaupt genug Parameter uebergeben + if( i >= nParamCount ) + { + p = new SbxVariable(); + p->PutErr( 448 ); // Wie in VB: Error-Code 448 (SbERR_NAMED_NOT_FOUND) + refParams->Put( p, i ); + } + else + { + p = refParams->Get( i ); + } + if( p->GetType() == SbxERROR && ( i ) ) + //if( p->GetType() == SbxEMPTY && ( i ) ) + { + // Wenn ein Parameter fehlt, kann er OPTIONAL sein + BOOL bOpt = FALSE; + SbxInfo* pInfo; + if( pMeth && ( pInfo = pMeth->GetInfo() ) ) + { + const SbxParamInfo* pParam = pInfo->GetParam( i ); + if( pParam && ( (pParam->nFlags & SBX_OPTIONAL) != 0 ) ) + bOpt = TRUE; + } + if( bOpt == FALSE ) + Error( SbERR_NOT_OPTIONAL ); + } + else if( t != SbxVARIANT && (SbxDataType)(p->GetType() & 0x0FFF ) != t ) + { + SbxVariable* q = new SbxVariable( t ); + SaveRef( q ); + *q = *p; + p = q; + } + SetupArgs( p, nOp1 ); + PushVar( CheckArray( p ) ); +} + +// Case-Test (+True-Target+Test-Opcode) + +void SbiRuntime::StepCASEIS( USHORT nOp1, USHORT nOp2 ) +{ + if( !refCaseStk || !refCaseStk->Count() ) + StarBASIC::FatalError( SbERR_INTERNAL_ERROR ); + else + { + SbxVariableRef xComp = PopVar(); + SbxVariableRef xCase = refCaseStk->Get( refCaseStk->Count() - 1 ); + if( xCase->Compare( (SbxOperator) nOp2, *xComp ) ) + StepJUMP( nOp1 ); + } +} + +// Aufruf einer DLL-Prozedur (+StringID+Typ) +// Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist + +void SbiRuntime::StepCALL( USHORT nOp1, USHORT nOp2 ) +{ + String aName = pImg->GetString( nOp1 & 0x7FFF ); + SbxArray* pArgs = NULL; + if( nOp1 & 0x8000 ) + pArgs = refArgv; + DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, FALSE ); + aLibName = String(); + if( nOp1 & 0x8000 ) + PopArgv(); +} + +// Aufruf einer DLL-Prozedur nach CDecl (+StringID+Typ) +// Auch hier zeigt das MSB des StringIDs an, dass Argv belegt ist + +void SbiRuntime::StepCALLC( USHORT nOp1, USHORT nOp2 ) +{ + String aName = pImg->GetString( nOp1 & 0x7FFF ); + SbxArray* pArgs = NULL; + if( nOp1 & 0x8000 ) + pArgs = refArgv; + DllCall( aName, aLibName, pArgs, (SbxDataType) nOp2, TRUE ); + aLibName = String(); + if( nOp1 & 0x8000 ) + PopArgv(); +} + + +// Beginn eines Statements (+Line+Col) + +void SbiRuntime::StepSTMNT( USHORT nOp1, USHORT nOp2 ) +{ + // Wenn der Expr-Stack am Anfang einen Statements eine Variable enthaelt, + // hat ein Trottel X als Funktion aufgerufen, obwohl es eine Variable ist! + BOOL bFatalExpr = FALSE; + if( nExprLvl > 1 ) + bFatalExpr = TRUE; + else if( nExprLvl ) + { + SbxVariable* p = refExprStk->Get( 0 ); + if( p->GetRefCount() > 1 + && refLocals.Is() && refLocals->Find( p->GetName(), p->GetClass() ) ) + bFatalExpr = TRUE; + } + // Der Expr-Stack ist nun nicht mehr notwendig + ClearExprStack(); + + // #56368 Kuenstliche Referenz fuer StepElem wieder freigeben, + // damit sie nicht ueber ein Statement hinaus erhalten bleibt + //refSaveObj = NULL; + // #74254 Jetzt per Liste + ClearRefs(); + + // Wir muessen hier hart abbrechen, da sonst Zeile und Spalte nicht mehr + // stimmen! + if( bFatalExpr) + { + StarBASIC::FatalError( SbERR_NO_METHOD ); + return; + } + pStmnt = pCode - 5; + USHORT nOld = nLine; + nLine = nOp1; + + // #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern + nCol1 = nOp2 & 0xFF; + + // Suchen des naechsten STMNT-Befehls, + // um die End-Spalte dieses Statements zu setzen + nCol2 = -1; + USHORT n1, n2; + const BYTE* p = pMod->FindNextStmnt( pCode, n1, n2 ); + if( p ) + { + if( n1 == nOp1 ) + { + // #29955 & 0xFF, um for-Schleifen-Ebene wegzufiltern + nCol2 = (n2 & 0xFF) - 1; + } + } + + // #29955 for-Schleifen-Ebene korrigieren, #67452 NICHT im Error-Handler sonst Chaos + if( !bInError ) + { + // (Bei Sprüngen aus Schleifen tritt hier eine Differenz auf) + USHORT nExspectedForLevel = nOp2 / 0x100; + USHORT nRealForLevel = 0; + SbiForStack* pFor = pForStk; + while( pFor ) + { + nRealForLevel++; + pFor = pFor->pNext; + } + + // Wenn der tatsaechliche For-Level zu klein ist, wurde aus + // einer Schleife heraus gesprungen -> korrigieren + while( nRealForLevel > nExspectedForLevel ) + { + PopFor(); + nRealForLevel--; + } + } + + // 16.10.96: #31460 Neues Konzept fuer StepInto/Over/Out + // Erklärung siehe bei _ImplGetBreakCallLevel. + if( pInst->nCallLvl <= pInst->nBreakCallLvl ) + //if( nFlags & SbDEBUG_STEPINTO ) + { + StarBASIC* pStepBasic = GetCurrentBasic( &rBasic ); + USHORT nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 ); + + // Neuen BreakCallLevel ermitteln + pInst->CalcBreakCallLevel( nNewFlags ); + } + + // Breakpoints nur bei STMNT-Befehlen in neuer Zeile! + else if( ( nOp1 != nOld ) + && ( nFlags & SbDEBUG_BREAK ) + && pMod->IsBP( nOp1 ) ) + { + StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic ); + USHORT nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 ); + + // Neuen BreakCallLevel ermitteln + pInst->CalcBreakCallLevel( nNewFlags ); + //16.10.96, ALT: + //if( nNewFlags != SbDEBUG_CONTINUE ) + // nFlags = nNewFlags; + } +} + +// (+SvStreamFlags+Flags) +// Stack: Blocklaenge +// Kanalnummer +// Dateiname + +void SbiRuntime::StepOPEN( USHORT nOp1, USHORT nOp2 ) +{ + SbxVariableRef pName = PopVar(); + SbxVariableRef pChan = PopVar(); + SbxVariableRef pLen = PopVar(); + short nBlkLen = pLen->GetInteger(); + short nChan = pChan->GetInteger(); + ByteString aName( pName->GetString(), gsl_getSystemTextEncoding() ); + pIosys->Open( nChan, aName, nOp1, nOp2, nBlkLen ); + Error( pIosys->GetError() ); +} + +// Objekt kreieren (+StringID+StringID) + +void SbiRuntime::StepCREATE( USHORT nOp1, USHORT nOp2 ) +{ + String aClass( pImg->GetString( nOp2 ) ); + SbxObject *pObj = SbxBase::CreateObject( aClass ); + if( !pObj ) + Error( SbERR_INVALID_OBJECT ); + else + { + String aName( pImg->GetString( nOp1 ) ); + pObj->SetName( aName ); + // Das Objekt muss BASIC rufen koennen + pObj->SetParent( &rBasic ); + SbxVariable* pNew = new SbxVariable; + pNew->PutObject( pObj ); + PushVar( pNew ); + } +} + +// #56204 Objekt-Array kreieren (+StringID+StringID), DCREATE == Dim-Create +void SbiRuntime::StepDCREATE( USHORT nOp1, USHORT nOp2 ) +{ + SbxVariableRef refVar = PopVar(); + DimImpl( refVar ); + + // Das Array mit Instanzen der geforderten Klasse fuellen + SbxBaseRef xObj = (SbxBase*)refVar->GetObject(); + if( !xObj ) + { + StarBASIC::Error( SbERR_INVALID_OBJECT ); + return; + } + + if( xObj->ISA(SbxDimArray) ) + { + SbxBase* pObj = (SbxBase*)xObj; + SbxDimArray* pArray = (SbxDimArray*)pObj; + + // Dimensionen auswerten + short nDims = pArray->GetDims(); + USHORT nTotalSize = 0; + + // es muss ein eindimensionales Array sein + short nLower, nUpper, nSize; + USHORT i; + for( i = 0 ; i < nDims ; i++ ) + { + pArray->GetDim( i+1, nLower, nUpper ); + nSize = nUpper - nLower + 1; + if( i == 0 ) + nTotalSize = nSize; + else + nTotalSize *= nSize; + } + + // Objekte anlegen und ins Array eintragen + String aClass( pImg->GetString( nOp2 ) ); + for( i = 0 ; i < nTotalSize ; i++ ) + { + SbxObject *pObj = SbxBase::CreateObject( aClass ); + if( !pObj ) + { + Error( SbERR_INVALID_OBJECT ); + break; + } + else + { + String aName( pImg->GetString( nOp1 ) ); + pObj->SetName( aName ); + // Das Objekt muss BASIC rufen koennen + pObj->SetParent( &rBasic ); + pArray->SbxArray::Put( pObj, i ); + } + } + } +} + +// Objekt aus User-Type kreieren (+StringID+StringID) +void SbiRuntime::StepTCREATE( USHORT nOp1, USHORT nOp2 ) +{ + String aName( pImg->GetString( nOp1 ) ); + String aClass( pImg->GetString( nOp2 ) ); + const SbxObject* pObj = pImg->FindType(aClass); + if (pObj) + { + SbxObject *pCopyObj = new SbxObject(*pObj); + pCopyObj->SetName(pImg->GetString( nOp1 )); + SbxVariable* pNew = new SbxVariable; + pNew->PutObject( pCopyObj ); + PushVar( pNew ); + } + else + Error( SbERR_INVALID_OBJECT ); +} + + + +// Einrichten einer lokalen Variablen (+StringID+Typ) + +void SbiRuntime::StepLOCAL( USHORT nOp1, USHORT nOp2 ) +{ + if( !refLocals.Is() ) + refLocals = new SbxArray; + String aName( pImg->GetString( nOp1 ) ); + SbxDataType t = (SbxDataType) nOp2; + SbxVariable* p = new SbxVariable( t ); + p->SetName( aName ); + refLocals->Put( p, refLocals->Count() ); +} + +// Einrichten einer modulglobalen Variablen (+StringID+Typ) + +void SbiRuntime::StepPUBLIC( USHORT nOp1, USHORT nOp2 ) +{ + String aName( pImg->GetString( nOp1 ) ); + SbxDataType t = (SbxDataType) nOp2; + BOOL bFlag = pMod->IsSet( SBX_NO_MODIFY ); + pMod->SetFlag( SBX_NO_MODIFY ); + SbProperty* pProp = pMod->GetProperty( aName, t ); + if( !bFlag ) + pMod->ResetFlag( SBX_NO_MODIFY ); + if( pProp ) + { + pProp->SetFlag( SBX_DONTSTORE ); + // AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden' + pProp->SetFlag( SBX_NO_MODIFY); + } + +} + +// Einrichten einer globalen Variablen (+StringID+Typ) + +void SbiRuntime::StepGLOBAL( USHORT nOp1, USHORT nOp2 ) +{ + String aName( pImg->GetString( nOp1 ) ); + SbxDataType t = (SbxDataType) nOp2; + BOOL bFlag = rBasic.IsSet( SBX_NO_MODIFY ); + rBasic.SetFlag( SBX_NO_MODIFY ); + SbxVariableRef p = rBasic.Find( aName, SbxCLASS_PROPERTY ); + if( p.Is() ) + rBasic.Remove (p); + p = rBasic.Make( aName, SbxCLASS_PROPERTY, t ); + if( !bFlag ) + rBasic.ResetFlag( SBX_NO_MODIFY ); + if( p ) + { + p->SetFlag( SBX_DONTSTORE ); + // AB: 2.7.1996: HACK wegen 'Referenz kann nicht gesichert werden' + p->SetFlag( SBX_NO_MODIFY); + } + +} + +// Einrichten einer statischen Variablen (+StringID+Typ) + +void SbiRuntime::StepSTATIC( USHORT nOp1, USHORT nOp2 ) +{ + /* AB #40689, wird nicht mehr verwendet + String aName( pImg->GetString( nOp1 ) ); + SbxDataType t = (SbxDataType) nOp2; + SbxVariable* p = new SbxVariable( t ); + p->SetName( aName ); + pInst -> GetStatics()->Put( p, pInst->GetStatics()->Count() ); + */ +} + + diff --git a/basic/source/runtime/win.asm b/basic/source/runtime/win.asm new file mode 100644 index 000000000000..067766a05173 --- /dev/null +++ b/basic/source/runtime/win.asm @@ -0,0 +1,72 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; WINOS2.ASM +;; +;; Ersterstellung MD 26.02.91 +;; +;; Stand +;; XX in Arbeit +;; XX fertiggestellt +;; __ abgenommen +;; __ freigegeben +;; +;; Anmerkungen +;; Direktaufruf von C- und PASCAL-Routinen, Windows und OS/2 +;; +;; Source Code Control System - Header +;; $Header: /zpool/svn/migration/cvs_rep_09_09_08/code/basic/source/runtime/win.asm,v 1.1.1.1 2000-09-18 16:12:11 hr Exp $ +;; +;; Copyright (c) 1990,95 by STAR DIVISION GmbH +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; Inhalt: +; type = CallXXX (far *proc, char *stack, short nstack) +; +; Kopie des Basic-Stacks (nstack Bytes) auf den C-Stack +; und Aufruf der Prozedur. + + .MODEL LARGE,C + + .CODE + + PUBLIC CallINT + PUBLIC CallLNG + PUBLIC CallSNG + PUBLIC CallDBL + PUBLIC CallSTR + PUBLIC CallFIX + +CallINT LABEL byte +CallLNG LABEL byte +CallSNG LABEL byte +CallDBL LABEL byte +CallSTR LABEL byte +CallFIX PROC p:PTR,stk:PTR,n:WORD + + PUSH SI + PUSH DI + MOV DX,DS + SUB SP,[n] + MOV DI,SP + MOV AX,SS + MOV ES,AX + LDS SI,[stk] + MOV CX,[n] + SHR CX,1 + CLD + JCXZ $1 + REP MOVSW ; Stack uebernehmen +$1: MOV DS,DX + CALL [p] ; Aufruf der Prozedur + CLI + MOV SP,BP + SUB SP,4 ; wegen gepushter Register + STI + POP DI + POP SI + RET + +CallFIX ENDP + + END diff --git a/basic/source/runtime/wnt.asm b/basic/source/runtime/wnt.asm new file mode 100644 index 000000000000..036959843ee9 --- /dev/null +++ b/basic/source/runtime/wnt.asm @@ -0,0 +1,84 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; WNT.ASM +;; +;; Ersterstellung MD 26.02.91 +;; +;; Stand +;; XX in Arbeit +;; XX fertiggestellt +;; __ abgenommen +;; __ freigegeben +;; +;; Anmerkungen +;; Direktaufruf von C- und PASCAL-Routinen, Windows und OS/2 +;; +;; Source Code Control System - Header +;; $Header: /zpool/svn/migration/cvs_rep_09_09_08/code/basic/source/runtime/wnt.asm,v 1.1.1.1 2000-09-18 16:12:11 hr Exp $ +;; +;; Copyright (c) 1990,95 by STAR DIVISION GmbH +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; Inhalt: +; type = CallXXX (far *pProc, char *pStack, short nStack) +; +; Kopie des Basic-Stacks (nStack Bytes) auf den C-Stack +; und Aufruf der Prozedur. + + .386 + +_TEXT SEGMENT DWORD PUBLIC 'CODE' USE32 + + ASSUME CS:_TEXT + + PUBLIC _CallINT@12 + PUBLIC _CallLNG@12 + PUBLIC _CallDBL@12 + PUBLIC _CallSTR@12 + PUBLIC _CallFIX@12 + +_CallINT@12 LABEL byte +_CallLNG@12 LABEL byte +_CallDBL@12 LABEL byte +_CallSTR@12 LABEL byte + +_CallFIX@12: PUSH EBP + MOV EBP,ESP + PUSH ESI + PUSH EDI + + PUSH ECX + PUSH EDX + + MOV DX,DS + MOVZX EAX,WORD PTR [EBP+16] ; EAX == nStack + SUB ESP,EAX ; Stack um nStack Bytes vergroessern + MOV EDI,ESP + MOV AX,SS + MOV ES,AX ; ES:EDI = Startadresse des fuer + ; Parameter reservierten Stackbereichs + MOV ESI,[EBP+12] ; DS:ESI == pStack + + MOVZX ECX,WORD PTR [EBP+16] ; ECX == nStack + SHR ECX,1 + CLD + JCXZ $1 + REP MOVSW ; Stack uebernehmen +$1: MOV DS,DX + CALL DWORD PTR [EBP+8] ; Aufruf der Prozedur + ; CLI ; unter NT nicht erlaubt (privileged instruction) + MOV ESP,EBP + SUB ESP,16 ; wegen gepushter Register + ; (ESI, EDI) + ; STI + POP EDX + POP ECX + POP EDI + POP ESI + POP EBP + RET 12 + +_TEXT ENDS + + END |