PowerBasic to PureBasic (PDF-attachement)

[Theo Gottwald]

Additionally some Sample code in PureBasic.

In PowerBasic, you could:

Mid$(PART1$, 4, 10) = PART2

In PureBasic, you can do the below. Note that specifying a "0" (zero) in the fourth parameter will cause all of B$
that will fit into the remaining lengh of the string pointed to by A to be utilized. This routine could be
reworked as a funcion but I suspect the below is faster because of its use of pointers. This is for ASCII only.

Usage: INS(@PART1$, PART2$, 4, 10)

Code Select Expand

Define.I
Procedure INS(*A, B$, C, D)
E = MemoryStringLength(*A): F = Len(B$)
If E = 0 Or F = 0 Or C < 1: RaiseError(5): EndIf
If D < 1 Or F < D: D = F: EndIf
E = E - C + 1
If E < D: D = E: EndIf
PokeS(*A + C - 1, B$, D, #PB_String_NoZero)
EndProcedure


Code Select Expand

Procedure.s x_mid(x.s,p.l,l.l,y.s)
  x=Left(x,p-1)+y+Mid(x,p+l,Len(x))
  ProcedureReturn x
EndProcedure

Code Select Expand

Procedure MidSet(*PtrStr.l, DestPos.l, DestLen.l, ReplaceStr.s)
 
  aMemPos.l=*PtrStr+DestPos-1
 
    If DestLen>1
      LastChar.b=PeekB(aMemPos+DestLen)
      PokeS(aMemPos, ReplaceStr, DestLen)
      PokeB(aMemPos+DestLen,LastChar)
    Else
      PokeB(aMemPos,PeekB(@ReplaceStr))
    EndIf
 
EndProcedure

or

Code Select Expand

Procedure MidSet(*PtrStr.l, DestPos.l, DestLen.l, ReplaceStr.s)

  aMemPos.l=*PtrStr+DestPos-1
  StrLen.l=MemoryStringLength(*PtrStr)

  If aMemPos>=*PtrStr
 
    If aMemPos<*PtrStr+StrLen
 
      If DestLen>Len(ReplaceStr)
        DestLen=Len(ReplaceStr)
      EndIf
     
      If DestPos+DestLen>StrLen
        DestLen=StrLen-DestPos+1
      EndIf
     
      If DestLen>1
        LastChar.b=PeekB(aMemPos+DestLen)
        PokeS(aMemPos, ReplaceStr, DestLen)
        PokeB(aMemPos+DestLen,LastChar)
      ElseIf DestLen=1
        PokeB(aMemPos,PeekB(@ReplaceStr))
      EndIf
     
    EndIf
   
  EndIf
 
EndProcedure

;---------------------------------------------
strTest.s="Hello"

MessageRequester("Before",strTest)

MidSet(@strTest, 3, 2, "Booh")

MessageRequester("After",strTest)

or

Code Select Expand

Procedure.s MidSet(string$,position,length,ReplaceString$); - Replace a part in the string and return the result
  ProcedureReturn Left(string$,position-1)+ReplaceString$+Right(string$,Len(string$)-position-length+1)
EndProcedure
Procedure MidSetDirect(*string.BYTE,position,*ReplaceString.BYTE); - Replace a part in the string direct!
  *string+(position-1)
  While *ReplaceString\b
    *string\b=*ReplaceString\b:*string+1:*ReplaceString+1
  Wend
EndProcedure

or optimized for speed:

Code Select Expand

Procedure MidSet_Fast(*PtrStr.BYTE, DestPos.l, DestLen.l, *ReplaceStr.BYTE)

  If DestLen>4
    CopyMemory(*ReplaceStr,*PtrStr+DestPos-1,DestLen)
  ElseIf DestLen=1
    *PtrStr+DestPos-1
    *PtrStr\b=*ReplaceStr\b
  ElseIf DestLen=2
    *PtrStr+DestPos-1
    *PtrStr\b=*ReplaceStr\b
    *PtrStr+1
    *ReplaceStr+1
    *PtrStr\b=*ReplaceStr\b
  ElseIf DestLen=3
    *PtrStr+DestPos-1
    *PtrStr\b=*ReplaceStr\b
    *PtrStr+1
    *ReplaceStr+1
    *PtrStr\b=*ReplaceStr\b
    *PtrStr+1
    *ReplaceStr+1
    *PtrStr\b=*ReplaceStr\b
  ElseIf DestLen=4
    *PtrStr+DestPos-1
    *PtrStr\b=*ReplaceStr\b
    *PtrStr+1
    *ReplaceStr+1
    *PtrStr\b=*ReplaceStr\b
    *PtrStr+1
    *ReplaceStr+1
    *PtrStr\b=*ReplaceStr\b
    *PtrStr+1
    *ReplaceStr+1
    *PtrStr\b=*ReplaceStr\b
  EndIf

EndProcedure

Code Select Expand

Procedure MidSet_Fast(*PtrStr.BYTE, DestPos.l, DestLen.l, *ReplaceStr.BYTE)
 
  If DestLen>1
    *PtrStr+DestPos-1+DestLen
    LastChar.b=*PtrStr\b
    PokeS(*PtrStr-DestLen, PeekS(*ReplaceStr, DestLen))
    *PtrStr\b=LastChar
  Else
    *PtrStr+DestPos-1
    *PtrStr\b=*ReplaceStr\b
  EndIf
 
EndProcedure


String Replacement:

Code Select Expand

Macro SRep(StringVar, Position, NewString, MaxChars = -1)
  PokeS(@StringVar + ((Position)-1)*SizeOf(CHARACTER), (NewString), MaxChars, #PB_String_NoZero)
EndMacro

test$ = "Hello World!"
Debug test$

SRep(test$,  2, "ond")
SRep(test$,  8, "eir???", 3)
Debug test$

Code Select Expand

; that first one can only "mid" single char of string
; problems will be if Pos set incorrectly
Macro PoorMidEmulation (pStr, Pos, Char)
   CompilerIf #PB_Compiler_Unicode
      PokeC(@pStr + (Pos - 1)  * 2, Asc(Char))
   CompilerElse
      PokeC(@pStr + (Pos - 1), Asc(Char))
   CompilerEndIf
EndMacro

; that second is a bit improved, it can "mid" a whole part of string
; again, problems will be if Pos set incorrectly
Macro PoorMidEmulation2 (pStr, Pos, Char)
   CompilerIf #PB_Compiler_Unicode
      CopyMemory(@Char, @pStr + (Pos - 1) * 2, Len(Char) * 2)
   CompilerElse
      CopyMemory(@Char, @pStr + (Pos - 1), Len(Char))
   CompilerEndIf
EndMacro

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Define.s TEST = "test"

Debug TEST ; clear variable

PoorMidEmulation(TEST, 1, "R")
Debug TEST   ; mid = single char

PoorMidEmulation2(TEST, 2, "ock")
Debug TEST   ; mid = part of string

TRIM$ in PureBasic:

Code Select Expand

EnableExplicit

#WHITESPACE$ = " " + #TAB$ + #CRLF$


Procedure.s LTrimAny (source$, charlist$=#WHITESPACE$)
   ; removes from source$ any leading character which is contained in charlist$
   Protected p.i, *s.Character
   
   p = 1
   *s = @source$
   While *s\c <> 0 And FindString(charlist$, Chr(*s\c)) <> 0
      p + 1
      *s + SizeOf(Character)
   Wend
   
   ProcedureReturn Mid(source$, p)
EndProcedure


Procedure.s RTrimAny (source$, charlist$=#WHITESPACE$)
   ; removes from source$ any trailing character which is contained in charlist$
   Protected p.i, *s.Character
   
   p = Len(source$)
   *s = @source$ + (p-1) * SizeOf(Character)
   While p >= 1 And FindString(charlist$, Chr(*s\c)) <> 0
      p - 1
      *s - SizeOf(Character)
   Wend
   
   ProcedureReturn Left(source$, p)
EndProcedure


Macro TrimAny (_source_, _charlist_=#WHITESPACE$)
   ; removes from source$ any leading or trailing character which is contained in charlist$
   LTrimAny(RTrimAny(_source_, _charlist_), _charlist_)
EndMacro


; == Demo ==
Macro ShowTrimming (_source_)
   Debug "#" +          _source_  + "#"
   Debug "#" + LTrimAny(_source_) + "#"
   Debug "#" + RTrimAny(_source_) + "#"
   Debug "#" + TrimAny (_source_) + "#"
   Debug ""
EndMacro

ShowTrimming("Hello")
ShowTrimming(#TAB$ + " Hello " + #TAB$)
ShowTrimming(#TAB$ + "  " + #TAB$)
ShowTrimming("")

In PowerBasic, you could:

A$ = "C:\SOMEDIR\SOMEFILE.*": If Dir$(A$) <> "" Then KILL A$

In PureBasic you can do the below.

Usage: A$ = "C:\SOMEDIR\SOMEFILE.*": DeleteFile(A$)

Code Select Expand

Procedure DELETEFILE(PATH$)
FOLDER$ = GetPathPart(PATH$)
MASK$ = GetFilePart(PATH$)
DIRN = ExamineDirectory(#PB_Any, FOLDER$, MASK$)
If DIRN = 0: ProcedureReturn: EndIf
While NextDirectoryEntry(DIRN) > 0
DeleteFile(FOLDER$ + "\" + DirectoryEntryName(DIRN))
Wend
FinishDirectory(DIRN)
EndProcedure