'Alternativa a Beep
Private Declare Sub bip Lib "MSVBVM60.dll" Alias "rtcBeep" ()
 
Private Sub Form_load()
bip
End Sub

'Asc$() Alternative function
'MSVBVM60.rtcAnsiValueBstr
Public Declare Function rtcAnsiValueBstr Lib "msvbvm60" (ByVal d As String) As Integer
 
Public Function Alternative_Asc(ByVal InputStr As String) As Integer
        Alternative_Asc = rtcAnsiValueBstr(StrConv(InputStr, vbUnicode))
End Function
 

'Chr$() Alternative function
'MSVBVM60.rtcBstrFromAnsi
Public Declare Function rtcBstrFromAnsi Lib "msvbvm60" (ByVal d As Integer) As String
 
Public Function Alternative_Chr(ByVal InputInt As Integer) As String
        Alternative_Chr = StrConv(rtcBstrFromAnsi(InputInt), vbFromUnicode)
End Function
 

'FileLen() Alternative function
'MSVBVM60.rtcFileLen
Public Declare Function rtcFileLen Lib "msvbvm60" (ByVal ptr As Long) As Long
 
Public Function Alternative_FileLen(ByVal FilePath As String) As Long
        Alternative_FileLen = rtcFileLen(StrPtr(FilePath))
End Function
 

'Mid$() Aletrnative function
'MSVBVM60.rtcMidCharBstr
 
Private Type VBvariant
        iType As Long
        reserved As Long
        lLen As Long
End Type
 
Public Declare Function rtcMidCharBstr Lib "msvbvm60" (ByVal sStr As String, ByVal Pos As Integer, ByVal iLen As Long) As String
 
Public Function Alternative_Mid(ByVal sStr As String, ByVal Pos As Integer, ByVal iLen As Long) As String
        Dim VBv As VBvariant
        VBv.iType = 2
        VBv.lLen = iLen
        Alternative_Mid = StrConv(rtcMidCharBstr(StrConv(sStr, vbUnicode), Pos, VarPtr(VBv.iType)), vbFromUnicode)
End Function
 

'StrConv() Alternative function
'MSVBVM60.rtcStrConvVar2
'MSVBVM60.__vbaVar2Vec
Type WeirdType
        Ptr1 As Long 'Holded data type
        Ptr2 As Long 'Address of last called function/api
        Ptr3 As Long 'ptr to converted data
        Ptr4 As Long 'ptr to VbVariant var
End Type
'MSVBVM60
Declare Function vbaVar2Vec Lib "MSVBVM60" Alias "__vbaVar2Vec" (ByRef ptr() As Byte, ByRef Des As WeirdType) As Long
Declare Function rtcStrConvVar2 Lib "MSVBVM60" (ByRef Des As WeirdType, ByRef Source As Variant, ByVal ConvType As Long, ByVal DontKnowIt As Long) As Long
 
Public Function Alternative_StrConv(ByVal Value As Variant, ByVal o As VbStrConv) As Variant
        Dim e1 As WeirdType
        Dim Arr() As Byte
        Arr = Value
        Value = Arr
        rtcStrConvVar2 e1, Value, o, &H0
        vbaVar2Vec Arr, e1
        Alternative_StrConv = Arr
End Function
 

'Hex$() Alternative function
'MSVBVM60.rtcHexBstrFromVar
Public Type VBvariant
        iType As Long
        Reserved As Long
        Value As Long
End Type
 
Public Declare Function rtcHexBstrFromVar Lib "MSVBVM60" (ByRef VarPtr As VBvariant) As String
 
Public Function Alternative_Hex(ByVal Value As Long) As String
Dim VbV As VBvariant
VbV.iType = 2
VbV.Value = Value
Alternative_Hex = StrConv(rtcHexBstrFromVar(VbV), vbFromUnicode)
End Function
 

'Split() Alternative function
'Coded By hamavb
 
'MSVBVM60.rtcSplit
'MSVBVM60.__vbaAryCopy
Public Type WeirdType
                e1 As Long
                e2 As Long
                e3 As Long
                e4 As Long
End Type
Public Declare Function rtcSplit Lib "MSVBVM60" (ByRef aa As WeirdType, ByVal ExpressionPtr As Long, ByRef sep As Variant, ByVal zz As Long, ByVal zzz As Long) As Long
Public Declare Function vbaAryCopy Lib "MSVBVM60" Alias "__vbaAryCopy" (ByRef lType() As String, ByVal aa As Long) As Long
Public Function Alternative_Split(ByVal Exp As String, ByVal sep As Variant, Optional ByVal Limit As Integer = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Variant
                Dim aa As WeirdType
                Dim f() As String
                rtcSplit aa, StrPtr(Exp), sep, Limit, Compare
                vbaAryCopy f, VarPtr(aa.e3)
                For i = LBound(f) To UBound(f)
                        f(i) = StrConv(f(i), vbFromUnicode)
                Next i
                Alternative_Split = f
End Function
 

'String$() Alternative function
'Coded by hamavb
'MSVBVM60.rtcStringBstr
Public Declare Function rtcStringBstr Lib "MSVBVM60" (ByVal Longeur As Long, ByRef VbV As Variant) As String
 
Public Function Alternative_String(ByVal iLen As Long, ByVal Char As Variant) As String
                Alternative_String = StrConv(rtcStringBstr(iLen, Char), vbFromUnicode)
End Function
 

'Replace() Alternative function
'Coded By hamavb
'MSVBVM60.rtcReplace
 
Public Declare Function rtcReplace Lib "MSVBVM60" (ByVal expression As String, ByVal Find As String, ByVal Replace As String, ByVal Start As Long, ByVal Count As Long, ByVal CompareMthd As Long) As String
 
Public Function Alternative_Replace(ByVal expression As String, ByVal Find As String, ByVal Replace As String, Optional ByVal Start As Long = 1, Optional ByVal Count As Long = -1, Optional ByVal CompareMthd As VbCompareMethod = vbBinaryCompare) As String
        Alternative_Replace = StrConv(rtcReplace(StrConv(expression, vbUnicode), StrConv(Find, vbUnicode), StrConv(Replace, vbUnicode), Start, Count, CompareMthd), vbFromUnicode)
End Function
 

'StrReverse() Alternative function
'MSVBVM60.rtcStrReverse
Public Declare Function rtcStrReverse Lib "MSVBVM60" (ByVal sStr As String) As String
Public Function Alternative_StrReverse(ByVal sStr As String) As String
        Alternative_StrReverse = StrConv(rtcStrReverse(StrConv(sStr, vbUnicode)), vbFromUnicode)
End Function
 

'Len() Alternative Function
'MSVBVM60.vbaLenBstr
Public Declare Function vbaLenBstr Lib "msvbvm60" Alias "__vbaLenBstr" (ByVal ptr As Long) As Long
 
Public Function Alternative_Len(ByVal sStr As String) As Long
        Alternative_Len = vbaLenBstr(StrPtr(sStr))
End Function
 

'Space$() Alternative Function
'MSVBVM60.rtcSpaceBstr
Public Declare Function rtcSpaceBstr Lib "MSVBVM60" (ByVal Longeur As Long) As String
 
Public Function Alternative_Space(ByVal iLen As Long) As String
        Alternative_Space = StrConv(rtcSpaceBstr(iLen), vbFromUnicode)
End Function
 

'Left$() Alternative Function
'MSVBVM60.rtcLeftCharBstr
Public Declare Function rtcLeftCharBstr Lib "MSVBVM60" (ByVal sStr As String, ByVal iLen As Integer) As String
 
Public Function Alternative_Left(ByVal sStr As String, ByVal iLen As Integer)
        Alternative_Left = StrConv(rtcLeftCharBstr(StrConv(sStr, vbUnicode), iLen), vbFromUnicode)
End Function
 

'Right$() Alternative Function
'MSVBVM60.rtcRightCharBstr
Public Declare Function rtcRightCharBstr Lib "MSVBVM60" (ByVal sStr As String, ByVal iLen As Integer) As String
 
Public Function Alternative_Right(ByVal sStr As String, ByVal iLen As Integer)
        Alternative_Right = StrConv(rtcRightCharBstr(StrConv(sStr, vbUnicode), iLen), vbFromUnicode)
End Function
 

'InStr Alternative function
'MSVBVM60.__vbaInStr
Public Declare Function InStr Lib "MSVBVM60" Alias "__vbaInStr" (Optional ByVal Start As Long = -1, Optional ByVal Exp As String = "", Optional ByVal Find As String = "", Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
 
Public Function Alternative_InStr(Optional ByVal Start As Long = -1, Optional ByVal Exp As String = "", Optional ByVal Find As String = "", Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
        Alternative_InStr = InStr(Start, Exp, Find, Compare)
End Function
 

'InStrRev Alternative function
'MSVBVM60.rtcInStrRev
Public Declare Function InStrRev Lib "MSVBVM60" Alias "rtcInStrRev" (ByVal Exp As String, ByVal Find As String, Optional ByVal Start As Long = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
 
Public Function Alternative_InStrRev(ByVal Exp As String, ByVal Find As String, Optional ByVal Start As Long = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
        Alternative_InStrRev = InStrRev(StrConv(Exp, vbUnicode), StrConv(Find, vbUnicode), Start, Compare)
End Function
 

'Ubound Alternative Function
'MSVBVM60.__vbaUbound
Public Declare Function iUBound Lib "MSVBVM60" Alias "__vbaUbound" (ByVal ptr As Long, ByVal Exp As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
 
Public Function Alternative_UBound(vbv As Variant) As Long
        Dim a As Long
        Dim aa As Long
        a = VarPtr(vbv) + &H8
        CopyMemory aa, ByVal a, &H4
        CopyMemory a, ByVal aa, &H4
        Alternative_UBound = iUBound(&H1, a)
End Function
 

'Lbound Alternative Function
'MSVBVM60.__vbaLbound
Public Declare Function iLBound Lib "MSVBVM60" Alias "__vbaLbound" (ByVal ptr As Long, ByVal Exp As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
 
Public Function Alternative_LBound(vbv As Variant) As Long
        Dim a As Long
        Dim aa As Long
        a = VarPtr(vbv) + &H8
        CopyMemory aa, ByVal a, &H4
        CopyMemory a, ByVal aa, &H4
        Alternative_LBound = iLBound(&H1, a)
End Function
 

'Alternative_CLng Function
'MSVBVM60.__vbaI4Str
Declare Function vbaI4Str Lib "msvbvm60" Alias "__vbaI4Str" (ByVal sStr As String) As Long
 
Public Function Alternative_Clng(ByVal expression As Variant) As Long
        Dim Exp As String
        Exp = expression
        Alternative_Clng = vbaI4Str(StrConv(Exp, vbUnicode))
End Function
 

'Alternative_CInt Function
'MSVBVM60.__vbaI2Str
Declare Function vbaI2Str Lib "msvbvm60" Alias "__vbaI2Str" (ByVal sStr As String) As Long
 
Public Function Alternative_CInt(ByVal expression As Variant) As Long
        Dim Exp As String
        Exp = expression
        Alternative_CInt = vbaI2Str(StrConv(Exp, vbUnicode))
End Function
 

'Alternative_Environ Function
'MSVBVM60.rtcEnvironBstr
Private Declare Function rtcEnvironBstr Lib "MSVBVM60" (ByVal ItemPtr As Long) As String
Function Alternative_Environ(ByVal Item As Variant) As String
        Alternative_Environ = StrConv(rtcEnvironBstr(Item), vbFromUnicode)
End Function
 

'Alternativa a Environ (versión de Kracrack)
Option Explicit
Private Type environstruct
    k       As Long '8
    null    As Long '0
    envstr  As Long 'StrPtr(str)
End Type
 
'MSVBVM60
Private Declare Function rtcEnvironBstr Lib "MSVBVM60" (ByRef struct As environstruct) As String
 
Private Sub Form_Load()
    Dim es  As environstruct
 
    With es
        .k = 8
        .envstr = StrPtr("TMP")
    End With
 
    MsgBox StrConv(rtcEnvironBstr(es), vbFromUnicode)
End Sub

'Alternatime_Trim Function
'MSVBVM60.rtcTrimBstr
Private Declare Function rtcTrimBstr Lib "MSVBVM60" (ByVal ItemPtr As String) As String
Function Alternatime_Trim(ByVal StrItem As String) As String
        Alternatime_Trim = StrConv(rtcTrimBstr(StrConv(StrItem, vbUnicode)), vbFromUnicode)
End Function
 

'Alternatime_LTrim Function
'MSVBVM60.rtcLeftTrimBstr
Private Declare Function rtcLeftTrimBstr Lib "MSVBVM60" (ByVal ItemPtr As String) As String
Function Alternatime_LTrim(ByVal StrItem As String) As String
        Alternatime_LTrim = StrConv(rtcLeftTrimBstr(StrConv(StrItem, vbUnicode)), vbFromUnicode)
End Function
 

'Alternatime_RTrim Function
'MSVBVM60.rtcRightTrimBstr
Private Declare Function rtcRightTrimBstr Lib "MSVBVM60" (ByVal ItemPtr As String) As String
Function Alternatime_RTrim(ByVal StrItem As String) As String
        Alternatime_RTrim = StrConv(rtcRightTrimBstr(StrConv(StrItem, vbUnicode)), vbFromUnicode)
End Function
 

'Obtener localeID (por karcrack)
Private Declare Function rtcGetHostLCID Lib "MSVBVM60" () As Long
Private Sub Form_Load()
   MsgBox rtcGetHostLCID
End Sub