[VB6] Alternativa funciones del VB6 [MSVBVM60 - API]

[STARZ]

Leyendo un post de hace unos dias de Karcrack en donde explicaba brevemente como obtener el LocaleID con una API de MSVBVM60 indocumentada (en el buen sentido de la palabra) me puse a investigar un poco sobre esta dll fundamental para el VB6. Ya habia notado que Karcrack la habia usado para su Invoke con la funcion Zombie y Addref, etc.
Googleando un poco encontre sitios en donde ya la habian debuggeado:

http://andrewl.dreamhosters.com/archive/67162323.txt
http://www.decompiler-vb.net/documentation/MSVBVM60%20vs%20VBReFormer.pdf

Me intereso muchisimo el tema, aunque no se como usarlas   Si se fijan, existen varias que son interesantes:

__vbaFileOpen
__vbaFileClose
rtcGetYear
__vbaWriteFile
rtcRemoveDir
rtcKillFiles
rtcFileCopy
rtcSetFileAttr
__vbaEnd
rtcShell
rtcSendKeys
rtcDoEvents
rtcSplit

(en negrita aquellas funciones que son algo detectadas por los AVs y que por ende estaria bueno trabajar sobre ellas)

Esta ultima la pude plasmar en una linda funcion  

Código (vb) [Seleccionar] Expandir


'Alternativa a End
Private Declare Sub Chau Lib "MSVBVM60.dll" Alias "__vbaEnd" ()

Private Sub Form_Load()
MsgBox "Me voy a cerrar solito :)"
Chau
End Sub

'Nota: no funciona en la IDE, solo compilado


No se si a alguien le interesa, supongo que Karcrack que esta mas experimentado en el tema me/nos podria dar una manito. Estaria genial si me ayudan a crear todas las otras o mas funciones/subs.

[STARZ]

Aca otro ejemplo facilito

Código (vb) [Seleccionar] Expandir


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

Private Sub Form_load()
bip
End Sub

[The Swash]

Hola,

Hombre, creo que funciones como OPEN y CLOSE llaman a varias de las funciones mencionadas.
Que lo confirme Karcrack (:

Un saludo,
Iván Portilla.

[STARZ]

Seguí investigando y por suerte ya me habían ganado de mano, ninguna solucionaba las funciones que había posteado arriba, como "__vbaFileOpen" ; "__vbaFileClose" ; "rtcKillFiles" ; "rtcFileCopy", pero algo es algo

'Asc$() Alternative function:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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):

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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):

Código (vb) [Seleccionar] Expandir


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


fuentes:
http://foro.elhacker.net/programacion_visual_basic/vbundocumented_obtener_localeid_de_forma_nativa-t362448.0.html
http://foro.elhacker.net/programacion_visual_basic/rtcenvironbstr_declare_help-t355859.0.html
http://www.imsecure.org/forum/topic/41106-alternative-functions/page__st__0