Creadas por HAMAVB:
[code]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
' by hamavb
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[/code]
'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
' by hamavb
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[/code]
Aqui otras creadas por icodeinvb6:
[code]Alternative Space$
Public Function AltSpace(ByVal Number As Long) As String
Dim bArr() As Byte
Dim ubArr As Long
Dim i As Long
If Number <= 0 Then AltSpace = vbNullString: Exit Function
ReDim bArr((Number * 2) - 1) ' *2 for unicode, -1 for array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2 ' Build unicode array
bArr(i) = 32 ' 32 is the ASCII character for a space
bArr(i + 1) = 0 ' Null character
Next i
AltSpace = bArr ' Convert unicode array to unicode string
End Function
Alternative String$
Public Function AltString(ByVal Number As Long, ByVal Character As Integer) As String
Dim bArr() As Byte
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim ubArr As Long
Dim i As Long
If Number <= 0 Then AltString = vbNullString: Exit Function
ReDim bArr((Number * 2) - 1) ' *2 for unicode, -1 for array
ubArr = UBound(bArr) ' Highest possible number in array
If Character > &HFF Then ' If character is unicode
Byte1 = Character Mod &H100
Byte2 = CInt(Character / &H100)
Else ' If character is ANSI
Byte1 = Character ' ANSI character
Byte2 = 0 ' Null character
End If
For i = 0 To ubArr Step 2 ' Build unicode array
bArr(i) = Byte1
bArr(i + 1) = Byte2
Next i
AltString = bArr ' Convert unicode array to unicode string
End Function
Alternative ChrW$
Public Function AltChrW(ByVal Character As Integer) As String
Dim bArr(1) As Byte
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim i As Long
If Character < 0 Then Exit Function
If Character > &HFF Then ' If character is unicode
Byte1 = Character Mod &H100
Byte2 = CInt(Character / &H100)
Else ' If character is ANSI
Byte1 = Character ' ANSI character
Byte2 = 0 ' Null character
End If
bArr(0) = Byte1
bArr(1) = Byte2
AltChrW = bArr ' Convert unicode array to unicode string
End Function
Alternative AscW
Public Function AltAscW(ByVal sString As String) As Integer
Dim bArr() As Byte
If sString = vbNullString Then Exit Function
bArr = sString ' Convert unicode string to unicode array
AltAscW = bArr(0) + (bArr(1) * &H100) ' Value of first unicode character
End Function
Alternative Left$
Public Function AltLeft(ByVal sString As String, ByVal Length As Long) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim ubArr As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
Length = (Length * 2) - 1 ' *2 for unicode, -1 for array
If Length > ubArr Then Length = ubArr ' If length is longer than string
ReDim bNew(Length) ' Resize new array to appropriate size
For i = 0 To Length ' New array from old array
bNew(i) = bArr(i)
Next i
AltLeft = bNew ' Convert unicode array to unicode string
End Function
Alternative Right$
Public Function AltRight(ByVal sString As String, ByVal Length As Long) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim lbArr As Long
Dim ubArr As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
If Length = 0 Then ' If length is 0
AltRight = vbNullString: Exit Function ' Return nothing
ElseIf Length < 0 Then ' Check for numbers less than 0
Err.Raise (5): Exit Function ' Invalid procedure call or argument
End If
Length = (Length * 2) - 1 ' *2 for unicode, -1 for array
If Length > ubArr Then Length = ubArr ' If length is longer than array
lbArr = ubArr - Length ' Start new array here
ReDim bNew(Length) ' Resize new array to appropriate size
For i = lbArr To ubArr ' New array from old array
bNew(i - lbArr) = bArr(i)
Next i
AltRight = bNew ' Convert unicode array to unicode string
End Function
Alternative Mid$
Public Function AltMid(ByVal sString As String, ByVal Start As Long, Optional ByVal Length As Variant) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim ubArr As Long
Dim ubNew As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
Start = (Start - 1) * 2 ' -1 for array, *2 for unicode
If IsMissing(Length) Then Length = (ubArr + 1) / 2 ' Check if Length is omitted
If Length = 0 Then ' If length is 0
AltMid = vbNullString: Exit Function ' Return nothing
ElseIf Length < 0 Then ' Check for numbers less than 0
Err.Raise (5): Exit Function ' Invalid procedure call or argument
End If
Length = (Length * 2) - 1 ' *2 for unicode, -1 for array
If Start + Length > ubArr Then Length = ubArr - Start ' If Start + Length is
' longer than array
ReDim bNew(Length) ' Resize new array to appropriate size
For i = Start To Start + Length ' New array from old array
bNew(i - Start) = bArr(i)
Next i
AltMid = bNew ' Convert unicode array to unicode string
End Function
Alternative Trim$
Public Function AltTrim(ByVal sString As String) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim ubArr As Long
Dim lStart As Long
Dim lEnd As Long
Dim lLen As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2 ' Look at beginning going forwards for spaces
If bArr(i) + (bArr(i + 1) * &H100) <> 32 Then lStart = i: Exit For
Next i
For i = ubArr - 1 To lStart Step -2 ' Look at end going backwards for spaces
If bArr(i) + (bArr(i + 1) * &H100) <> 32 Then lEnd = i + 1: Exit For
Next i
lLen = lEnd - lStart ' Get length of unicode string without spaces
ReDim bNew(lLen) ' Resize new array to appropriate size
For i = lStart To lEnd ' New array from old array
bNew(i - lStart) = bArr(i)
Next i
AltTrim = bNew ' Convert unicode array to unicode string
End Function
Alternative Len
Public Function AltLen(ByVal Temp As Variant) As Long
Dim bArr() As Byte
Dim ubArr As Long
bArr = Temp ' Convert Temp variable to array
ubArr = UBound(bArr) ' Highest possible number in array
AltLen = (ubArr + 1) / 2 ' +1 for non-array, /2 for ansi
End Function
Alternative UCase$
Public Function AltUCase(ByVal sString As String) As String
Dim bArr() As Byte
Dim ubArr As Long
Dim lDif As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2
If bArr(i) > 96 And bArr(i) < 123 Then ' If unicode character is a lowercase letter
lDif = bArr(i) - 97 ' Get placement of letter in alphabet
bArr(i) = lDif + 65 ' Use only uppercase letters for replacing
End If
Next i
AltUCase = bArr ' Convert unicode array to unicode string
End Function
Alternative LCase$
Public Function AltLCase(ByVal sString As String) As String
Dim bArr() As Byte
Dim ubArr As Long
Dim lDif As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2
If bArr(i) > 64 And bArr(i) < 91 Then ' If unicode character is a lowercase letter
lDif = bArr(i) - 65 ' Get placement of letter in alphabet
bArr(i) = lDif + 97 ' Use only uppercase letters for replacing
End If
Next i
AltLCase = bArr ' Convert unicode array to unicode string
End Function
Alternative UBound
Public Function AltUBound(ByVal vTemp As Variant) As Long
On Error GoTo PastLimit
Dim lCount As Long
Dim vTest As Variant
If IsArray(vTemp) = False Then MsgBox "Not an array!": Exit Function
Do ' Loop until we hit the error
vTest = vTemp(lCount): lCount = lCount + 1 ' Copy dummy value, increase counter
Loop
PastLimit: ' Found the end of the array
If lCount = 0 Then MsgBox "Array not initialized!": Exit Function
AltUBound = lCount - 1
End Function
Alternative InStr
Public Function AltInStr(ByVal String1 As String, ByVal String2 As String, Optional ByVal Start As Long = 1) As Long
Dim bFound As Boolean
Dim bArr1() As Byte
Dim bArr2() As Byte
Dim ubArr1 As Long
Dim ubArr2 As Long
Dim lPos As Long
Dim i As Long
Dim j As Long
bArr1 = String1 ' Convert unicode string to unicode array
bArr2 = String2 ' Convert unicode string to unicode array
ubArr1 = UBound(bArr1) ' Highest possible number in array
ubArr2 = UBound(bArr2) ' Highest possible number in array
For i = (Start - 1) * 2 To ubArr1 ' Loop through String1
If i + ubArr2 > ubArr1 Then GoTo Not_Found ' End of String1
For j = 0 To ubArr2 ' Loop through String2
If bArr2(j) <> bArr1(i + lPos) Then Exit For ' Compare byte by byte
If j = ubArr2 Then bFound = True ' If all bytes have matched
lPos = lPos + 1 ' Go to next position
Next j
If bFound = True Then Exit For ' If String2 has been found in String1
Next i
AltInStr = (i / 2) + 1 ' Adjust for position in ANSI string
Exit Function
Not_Found:
End Function
[/code]
Public Function AltSpace(ByVal Number As Long) As String
Dim bArr() As Byte
Dim ubArr As Long
Dim i As Long
If Number <= 0 Then AltSpace = vbNullString: Exit Function
ReDim bArr((Number * 2) - 1) ' *2 for unicode, -1 for array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2 ' Build unicode array
bArr(i) = 32 ' 32 is the ASCII character for a space
bArr(i + 1) = 0 ' Null character
Next i
AltSpace = bArr ' Convert unicode array to unicode string
End Function
Alternative String$
Public Function AltString(ByVal Number As Long, ByVal Character As Integer) As String
Dim bArr() As Byte
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim ubArr As Long
Dim i As Long
If Number <= 0 Then AltString = vbNullString: Exit Function
ReDim bArr((Number * 2) - 1) ' *2 for unicode, -1 for array
ubArr = UBound(bArr) ' Highest possible number in array
If Character > &HFF Then ' If character is unicode
Byte1 = Character Mod &H100
Byte2 = CInt(Character / &H100)
Else ' If character is ANSI
Byte1 = Character ' ANSI character
Byte2 = 0 ' Null character
End If
For i = 0 To ubArr Step 2 ' Build unicode array
bArr(i) = Byte1
bArr(i + 1) = Byte2
Next i
AltString = bArr ' Convert unicode array to unicode string
End Function
Alternative ChrW$
Public Function AltChrW(ByVal Character As Integer) As String
Dim bArr(1) As Byte
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim i As Long
If Character < 0 Then Exit Function
If Character > &HFF Then ' If character is unicode
Byte1 = Character Mod &H100
Byte2 = CInt(Character / &H100)
Else ' If character is ANSI
Byte1 = Character ' ANSI character
Byte2 = 0 ' Null character
End If
bArr(0) = Byte1
bArr(1) = Byte2
AltChrW = bArr ' Convert unicode array to unicode string
End Function
Alternative AscW
Public Function AltAscW(ByVal sString As String) As Integer
Dim bArr() As Byte
If sString = vbNullString Then Exit Function
bArr = sString ' Convert unicode string to unicode array
AltAscW = bArr(0) + (bArr(1) * &H100) ' Value of first unicode character
End Function
Alternative Left$
Public Function AltLeft(ByVal sString As String, ByVal Length As Long) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim ubArr As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
Length = (Length * 2) - 1 ' *2 for unicode, -1 for array
If Length > ubArr Then Length = ubArr ' If length is longer than string
ReDim bNew(Length) ' Resize new array to appropriate size
For i = 0 To Length ' New array from old array
bNew(i) = bArr(i)
Next i
AltLeft = bNew ' Convert unicode array to unicode string
End Function
Alternative Right$
Public Function AltRight(ByVal sString As String, ByVal Length As Long) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim lbArr As Long
Dim ubArr As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
If Length = 0 Then ' If length is 0
AltRight = vbNullString: Exit Function ' Return nothing
ElseIf Length < 0 Then ' Check for numbers less than 0
Err.Raise (5): Exit Function ' Invalid procedure call or argument
End If
Length = (Length * 2) - 1 ' *2 for unicode, -1 for array
If Length > ubArr Then Length = ubArr ' If length is longer than array
lbArr = ubArr - Length ' Start new array here
ReDim bNew(Length) ' Resize new array to appropriate size
For i = lbArr To ubArr ' New array from old array
bNew(i - lbArr) = bArr(i)
Next i
AltRight = bNew ' Convert unicode array to unicode string
End Function
Alternative Mid$
Public Function AltMid(ByVal sString As String, ByVal Start As Long, Optional ByVal Length As Variant) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim ubArr As Long
Dim ubNew As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
Start = (Start - 1) * 2 ' -1 for array, *2 for unicode
If IsMissing(Length) Then Length = (ubArr + 1) / 2 ' Check if Length is omitted
If Length = 0 Then ' If length is 0
AltMid = vbNullString: Exit Function ' Return nothing
ElseIf Length < 0 Then ' Check for numbers less than 0
Err.Raise (5): Exit Function ' Invalid procedure call or argument
End If
Length = (Length * 2) - 1 ' *2 for unicode, -1 for array
If Start + Length > ubArr Then Length = ubArr - Start ' If Start + Length is
' longer than array
ReDim bNew(Length) ' Resize new array to appropriate size
For i = Start To Start + Length ' New array from old array
bNew(i - Start) = bArr(i)
Next i
AltMid = bNew ' Convert unicode array to unicode string
End Function
Alternative Trim$
Public Function AltTrim(ByVal sString As String) As String
Dim bArr() As Byte
Dim bNew() As Byte
Dim ubArr As Long
Dim lStart As Long
Dim lEnd As Long
Dim lLen As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2 ' Look at beginning going forwards for spaces
If bArr(i) + (bArr(i + 1) * &H100) <> 32 Then lStart = i: Exit For
Next i
For i = ubArr - 1 To lStart Step -2 ' Look at end going backwards for spaces
If bArr(i) + (bArr(i + 1) * &H100) <> 32 Then lEnd = i + 1: Exit For
Next i
lLen = lEnd - lStart ' Get length of unicode string without spaces
ReDim bNew(lLen) ' Resize new array to appropriate size
For i = lStart To lEnd ' New array from old array
bNew(i - lStart) = bArr(i)
Next i
AltTrim = bNew ' Convert unicode array to unicode string
End Function
Alternative Len
Public Function AltLen(ByVal Temp As Variant) As Long
Dim bArr() As Byte
Dim ubArr As Long
bArr = Temp ' Convert Temp variable to array
ubArr = UBound(bArr) ' Highest possible number in array
AltLen = (ubArr + 1) / 2 ' +1 for non-array, /2 for ansi
End Function
Alternative UCase$
Public Function AltUCase(ByVal sString As String) As String
Dim bArr() As Byte
Dim ubArr As Long
Dim lDif As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2
If bArr(i) > 96 And bArr(i) < 123 Then ' If unicode character is a lowercase letter
lDif = bArr(i) - 97 ' Get placement of letter in alphabet
bArr(i) = lDif + 65 ' Use only uppercase letters for replacing
End If
Next i
AltUCase = bArr ' Convert unicode array to unicode string
End Function
Alternative LCase$
Public Function AltLCase(ByVal sString As String) As String
Dim bArr() As Byte
Dim ubArr As Long
Dim lDif As Long
Dim i As Long
bArr = sString ' Convert unicode string to unicode array
ubArr = UBound(bArr) ' Highest possible number in array
For i = 0 To ubArr Step 2
If bArr(i) > 64 And bArr(i) < 91 Then ' If unicode character is a lowercase letter
lDif = bArr(i) - 65 ' Get placement of letter in alphabet
bArr(i) = lDif + 97 ' Use only uppercase letters for replacing
End If
Next i
AltLCase = bArr ' Convert unicode array to unicode string
End Function
Alternative UBound
Public Function AltUBound(ByVal vTemp As Variant) As Long
On Error GoTo PastLimit
Dim lCount As Long
Dim vTest As Variant
If IsArray(vTemp) = False Then MsgBox "Not an array!": Exit Function
Do ' Loop until we hit the error
vTest = vTemp(lCount): lCount = lCount + 1 ' Copy dummy value, increase counter
Loop
PastLimit: ' Found the end of the array
If lCount = 0 Then MsgBox "Array not initialized!": Exit Function
AltUBound = lCount - 1
End Function
Alternative InStr
Public Function AltInStr(ByVal String1 As String, ByVal String2 As String, Optional ByVal Start As Long = 1) As Long
Dim bFound As Boolean
Dim bArr1() As Byte
Dim bArr2() As Byte
Dim ubArr1 As Long
Dim ubArr2 As Long
Dim lPos As Long
Dim i As Long
Dim j As Long
bArr1 = String1 ' Convert unicode string to unicode array
bArr2 = String2 ' Convert unicode string to unicode array
ubArr1 = UBound(bArr1) ' Highest possible number in array
ubArr2 = UBound(bArr2) ' Highest possible number in array
For i = (Start - 1) * 2 To ubArr1 ' Loop through String1
If i + ubArr2 > ubArr1 Then GoTo Not_Found ' End of String1
For j = 0 To ubArr2 ' Loop through String2
If bArr2(j) <> bArr1(i + lPos) Then Exit For ' Compare byte by byte
If j = ubArr2 Then bFound = True ' If all bytes have matched
lPos = lPos + 1 ' Go to next position
Next j
If bFound = True Then Exit For ' If String2 has been found in String1
Next i
AltInStr = (i / 2) + 1 ' Adjust for position in ANSI string
Exit Function
Not_Found:
End Function
[/code]