xsharp.eu

Code: Select all

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

// String Functions


USING System
USING System.Collections.Generic
USING System.Text
USING System.IO


/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/addbs/*" />
/// <seealso cref='M:XSharp.VFP.Functions.DefaultExt(System.String)' />
/// <seealso cref='M:XSharp.VFP.Functions.JustDrive(System.String)' />
/// <seealso cref='M:XSharp.VFP.Functions.JustExt(System.String)' />
/// <seealso cref='M:XSharp.VFP.Functions.JustFName(System.String)' />
/// <seealso cref='M:XSharp.VFP.Functions.JustPath(System.String)' />
/// <seealso cref='M:XSharp.VFP.Functions.JustStem(System.String)' />
FUNCTION AddBs (cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR delim := Path.DirectorySeparatorChar:ToString()
    cPath := cPath:TrimEnd()
    IF ! cPath.EndsWith(delim)
        cPath += delim
    ENDIF
    RETURN cPath


/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justdrive/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustDrive(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR result := System.IO.Directory.GetDirectoryRoot(cPath)
    result := result:Replace(Path.DirectorySeparatorChar:ToString(),"")
    RETURN result


/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justpath/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustPath(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    LOCAL cPathChar := Path.DirectorySeparatorChar:ToString() AS STRING
    LOCAL result := cPath AS STRING
    IF result:IndexOf(cPathChar) >= 0
        result := result:Substring(0, result:LastIndexOf(cPathChar) -1)
    ENDIF
    RETURN result


/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justfname/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustFName(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR result := Path.GetFileName(cPath)
    RETURN result


/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/juststem/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustStem(cPath AS STRING) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    VAR result := Path.GetFileNameWithoutExtension(cPath)
    RETURN result


/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justext/*" />
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/justcommon/*" />
FUNCTION JustExt(cPath AS STRING) AS STRING
    *-- Default for new parameter  lOptWithLeadingDot ist .f.
    *-- As returning all extensions with leading dot could lead to breaking changes
    return JustExt(cPath, .f.)

FUNCTION JustExt(cPath AS STRING, lOptWithLeadingDot AS BOOLEAN) AS STRING
    IF String.IsNullOrEmpty(cPath)
        RETURN ""
    ENDIF
    local result as STRING
    result := Path.GetExtension(cPath)
    *-- pcount() not allowed according to compiler
    *-- as types are known use __SubStr() from core
    if lOptWithLeadingDot=.f. and result:StartsWith(".")
        result := __SubStr(result, 2, -1)
    endif
    RETURN result


/// <summary>-- todo --</summary>
/// <include file="VFPDocs.xml" path="Runtimefunctions/forceext/*" />
FUNCTION ForceExt( cFileName AS STRING, cExtension AS STRING) AS STRING
    IF String.IsNullOrEmpty(cFileName)
        RETURN ""
    ENDIF
    VAR result := Path.ChangeExtension(cFileName,cExtension)
    RETURN result

FUNCTION ForceExt( cFileName AS STRING, cExtension AS STRING, tlOptAsVfp9 AS BOOLEAN) AS STRING
    *-- current take on matters is that the Dotnet-Version should be Default behaviour
    *-- as vfp9 version behaviour in edge cases could be seen as erroneous
    *-- work in progress and not tested, as existing code should only call 2-parameter overload should be safe
    if tlOptAsVfp9=.f. 
        return ForceExt( cFileName, cExtension)
    endif
    local lcFilename as string
    lcFilename := JustFName(cFileName)
    if lcFileName:EndsWith(".")
        *-- if filename ends with dot, cut that
        *-- but only rightmost one, ending in several dots cuts still only 1
        lcFileName := __SubStr(lcFileName, 1, lcFileName:Length-1 )
    endif
    var lcExtension := cExtension
    if cExtension:StartsWith(".")
        lcExtension := __SubStr(lcFileName, 2, -1)
    else
        lcExtension := cExtension
    endif
    local lcResult as STRING
    if min(len(lcFilename), len(lcExtension))>0
        lcResult := lcFilename + "." + lcExtension
    else
        lcResult := ""
    endif
    RETURN lcResult

/// <summary>-- todo --</summary>
/// <include file="VFPDocs.xml" path="Runtimefunctions/forcepath/*" />

FUNCTION ForcePath( cFileName AS STRING, cPath AS STRING) AS STRING
    *-- check if path needs also check...
    IF String.IsNullOrEmpty(cFileName)
        RETURN ""
    ENDIF
    var lcReturn := AddBS(cPath) + JustFName(cFileName)
    RETURN lcReturn
 
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/leftc/*" />
FUNCTION LeftC( cExpression AS STRING, nExpression AS DWORD) AS STRING
    RETURN Left(cExpression, nExpression)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/lenc/*" />
FUNCTION LenC( cExpression AS STRING ) AS DWORD
    RETURN SLen(cExpression)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/likec/*" />
FUNCTION LikeC( cExpression1, cExpression2) AS LOGIC
    RETURN Like(cExpression1, cExpression2)


/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/rightc/*" />
FUNCTION RightC( cExpression AS STRING, nCharacters AS DWORD) AS STRING
    RETURN Right(cExpression, nCharacters)

/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/stuffc/*" />
FUNCTION StuffC( cExpression, nStartReplacement, nCharactersReplaced, cReplacement) AS STRING
    RETURN Stuff(cExpression, nStartReplacement, nCharactersReplaced, cReplacement)
    
/// <include file="VfpRuntimeDocs.xml" path="Runtimefunctions/substrc/*" />
FUNCTION SubStrC(cExpression, nStartPosition , nCharactersReturned ) AS STRING
    RETURN SubStr(cExpression, nStartPosition, nCharactersReturned)

Code: Select all

/// <summary>Creates an object from a class definition or an Automation-enabled application.</summary>
/// <param name="cClassName">Specifies the class or OLE object from which the new object is created.</param>
/// <param name="_args">These optional parameters are used to pass values to the Init event procedure for the class.
/// The Init event is executed when you issue CREATEOBJECT( ) and allows you to initialize the object.</param>
/// <returns>The object that was created</returns>
/// <seealso cref='M:XSharp.RT.Functions.CreateInstance(XSharp.__Usual,XSharp.__Usual)' >CreateInstance</seealso>

FUNCTION CreateObject(cClassName, _args ) AS OBJECT CLIPPER
    // The pseudo function _ARGS() returns the Clipper arguments array
    RETURN CreateInstance(_ARGS())

/// <include file="VFPDocs.xml" path="Runtimefunctions/createobjectex/*" />
FUNCTION CreateObjectEx(cClsIdOrcProgId, cComputerName , cIID ) AS OBJECT CLIPPER
    // The pseudo function _ARGS() returns the Clipper arguments array
    RETURN CreateInstance(_ARGS())


PROCEDURE RddInit() AS VOID _INIT3
    // Make sure that the VFP dialect has the DBFVFP driver as default RDD
    RddSetDefault("DBFVFP")
    RuntimeState.SetValue(Set.FoxCollate,"")
    RuntimeState.SetValue(Set.MemoWidth, 50)
    RuntimeState.SetValue(Set.Near, FALSE)
    RuntimeState.SetValue(Set.SqlAnsi, FALSE)
    RuntimeState.SetValue(Set.FoxLock, TRUE)
    RuntimeState.SetValue(Set.Eof, TRUE)
    RETURN 



Function SetFoxCollation(cCollation as STRING) AS STRING
local cOld := RuntimeState.GetValue<STRING>(Set.FoxCollate) AS STRING
local aAllowed as STRING[]
LOCAL lOk := FALSE as LOGIC
LOCAL cValue := cCollation as STRING
aAllowed := System.Enum.GetNames(typeof(XSharp.FoxCollations))
cValue := cValue:Trim():ToUpper()
FOREACH VAR cEnum in aAllowed
    IF String.Compare(cValue, cEnum, StringComparison.OrdinalIgnoreCase) == 0
        lOk := TRUE
        EXIT
    ENDIF
NEXT
IF lOk
    RuntimeState.SetValue(Set.FoxCollate,cValue)
ELSE
    local oError as Error
    oError := Error.ArgumentError(__FUNCTION__, nameof(cCollation), 1, {cCollation})
    oError:Description := "Collating sequence '"+cCollation+"' is not found"
    oError:Throw()
ENDIF
RETURN cOld

function ICase(lCond1, uExp1, lCond2, uExp2) as usual
     LOCAL nCount := PCount() AS LONG
    // loop through the actual parameters. The odd parameters should be logic
    // the even parameters are return values for their siblings.
    for var nI := 1 to nCount-1 step 2
        local cond := _GetFParam(nI) as logic
        if cond
            return _GetFParam(nI+1)
        endif
    next
    // no conditions are met, if the # of parameters is odd then return the last value
    if nCount % 2 == 1
        return _GetFParam(nCount)
    endif
    // the # of parameters is even. When >= 2 then get the type of parameter 2 and return an empty value
    if PCount() >= 2
        var type := Usual

Code: Select all

		lnCnt = getwordcount(longtxt.mtext,lcWhite,REF lnSwitch)

Code: Select all

for lnRun := 1 to GetwordCount(lcString [, lcFixedDelimiters])
    = DoSomething(GetWordNum(lcString, lnRun[, lcFixedDelimiters])
next

Code: Select all

scan for few_million_rows
    this.GetAllWords_and_handle_Name(CustNames->Name)
    this.GetAllWords_and_handle_Name(CustNames->Normalized_Name)
    select Adress
    scan for Adress.fk == CustNames.pk
        this.GetAllWords_and_handle_Adr(Adress->Adr)
        this.GetAllWords_and_handle_Adr(Adress->Normalized_Adr)
    endscan
    *--- for some other tables similar 0..N scan too wieldy to put into 1 denormalzed cursor
    select CustNames
endscan

Code: Select all

self:oGetWordHandler := GetWordHandler{}  && xSharp Core style
= self:oGetWordHandler:SetDelimiter(Space(1))
scan for few_million_rows
    *--- same as above
endscan

Code: Select all

*-- was planned
for lnRun := 1 to self:oGetWordHandler:GetwordCount(tcString)
   = DoSomething(self:oGetWordHandler:GetWordNum(tcString, lnRun)
next
*-- in view of delegate performance, probably Inheritance-based
local loExecutor := self:oGetWordHandler:oActiveExecutor as GetWordExecutor
for lnRun := 1 to loExecutor:GetwordCount(tcString)
    = DoSomething(loExecutor:GetWordNum(tcString, lnRun)
next

Code: Select all

   FUNCTION GetWordCount( tcString AS STRING, tcDelimiters AS STRING, tnSwitch ref Int) AS LONG
        *-- Checked: throws on .Null.
        local lnReturn as Int
        local loSrch As GetWordHandler
        loSrch := GetWordHandler {}
        loSrch:SetDelimiter(tcDelimiters, ref tnSwitch)
        lnReturn := loSrch:GetWordCount(tcString)
        RETURN lnReturn
    *-- based on current implementation, not pie-in-the-sky from above
    Global __goGetWordHandler := GetWordHandler {} as GetWordHandler
    FUNCTION GetWordCount2( tcString AS STRING, tcDelimiters AS STRING, tnSwitch ref Int) AS LONG
        *-- Checked: throws on .Null.
        local lnReturn as Int
        __goGetWordHandler:SetDelimiter(tcDelimiters, ref tnSwitch)
        lnReturn := __goGetWordHandler:GetWordCount(tcString)
        RETURN lnReturn