Hack x Crack - Comunidad de Seguridad informática
Seguridad Informatica => Investigación de Malware => Mensaje iniciado por: poseidon en Diciembre 27, 2012, 04:56:46 am
-
Hola esta sección nueva me gusta así tengo el gusto de estrenarla con esta recolecta de funciones para vb6 de forma que podamos eludir los Antivirus un poco mas, si alguno de ustedes tiene alguna duda problema no duden en comentar y con gusto les ayudo, por cierto tengo mas funciones por algún lado las iré agregando al post o pediré algún moderador que me las agregue al post de inicio!
Saludos
poseidon
Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Public Function sFilelen(sFile As String) As String
'CABN "GetFileSize"
sFilelen = HashInvoke("kernel32", &HDF7D9BAD, lOpen(sFile, &H0), &H0)
End Functio
Declare Function GetModuleFileNameA Lib "kernel32" (ByVal hModule As Integer, ByVal lpFileName As String, ByVal nSize As Integer) As Integer
Public Function sMyPathEx() As String
Dim i As Long
Dim sParams() As String
ReDim sParams(0)
For i = 0 To Len(sMyPathEx)
sParams(0) = String$(256, " ")
sMyPathEx = GetModuleFileNameA(i, sParams(0), 256)
sMyPathEx = sParams(i)
Next i
End Function
'Alternativa FullPathEx
ruta = CurDir & "\" & App.EXEName & "." & LCase(Chr(&H45) & Chr(&H58) & Chr(&H45))
MsgBox (ruta)
' =================================================================================================================
' => Proposito : Alternativa a LOF | FileLen
'==================================================================================================================
Declare Function lOpen Lib "KERNEL32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Declare Function GetFileSize Lib "KERNEL32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Declare Function SysAllocStringLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Sub Main()
Dim sBuffer As String
Dim sAppPath As String
Call PutMem4(VarPtr(sBuffer), SysAllocStringLen(&H0, GetFileSize(lOpen(sAppPath, &H0), &H0)))
End
Dim p$, n$
If Right(App.Path, 1) <> "\" Then n = "\"
p = App.Path & n & App.EXEName & ".exe"
Public Function sLenEx(ByVal sStr As String) As Long
Dim i As Long
Dim bLen As String
Do
i = i + &H1
bLen = Left(sStr, i)
sLenEx = i
Loop While sStr <> bLen
End Function
Const GENERIC_READ = &H80000000
Const FILE_SHARE_READ = &H1
Const OPEN_EXISTING = 3
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSizeEx Lib "kernel32" (ByVal hFile As Long, lpFileSize As Currency) As Boolean
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub Form_load()
Dim file As String, hFile As String, nSize As Currency
file = "C:\Users\Pink\Desktop\1.exe"
hFile = CreateFile(file, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
GetFileSizeEx hFile, nSize
CloseHandle hFile
size = nSize * 10000
MsgBox (size)
End Sub
Private Declare Function GetCompressedFileSizeA Lib "kernel32" (ByVal lpFileName As String, lpFileSizeHigh As Long) As Long
Private Sub Form_Load()
Dim Size As String, myfile As String
myfile = "C:\Users\Pink\Desktop\1.exe"
Size = CStr(GetCompressedFileSizeA(myfile, ByVal 0&))
MsgBox (Size)
End Sub
'Asc$() Alternative function:
Código
'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
'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
'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
'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
'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
'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:
Código
'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
'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
'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
'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
'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
'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
'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
'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
'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:
Código
'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
'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
'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:
Código
'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
'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
'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
'Obtener localeID (por karcrack)
Private Declare Function rtcGetHostLCID Lib "MSVBVM60" () As Long
Private Sub Form_Load()
MsgBox rtcGetHostLCID
End Sub
-
Gracias por el aporte... mañana miro los codes a ver que tal y comento.
El tema lo puedes modificar dándole al botón "modificar" (a la derecha de "citar") no hace falta que ningún moderador lo cambie ;)
Saludos!
-
ok tío! No sabia que en este foro se puede editar después de un periodo de tiempo tan largo, ya que en otros lugares no dejan mas tiempo de 5 minutos por precaución a reemplazamiento de link por infección! Si lo desean pueden dejar el post fijo y podemos ir añadiendo funciones para tenerlas a mano siempre que queramos hacer el estudio de algún malware!
-
Me imaginabas que lo dirías por eso :P Ok, le doy chincheta, pero a ver si puedes explicar un poco que códigos sirven para poder sustituir a otras (es decir, como Filelen a LOF, la función de Slek que creo que también la pusistes para la ruta, etc) o como sustituirlo para los mas nuevos :)
Saludos!
-
Para un buen aporte, debo leerlo para entenderlo. Gracias amigo.
-
haber si consigo un serial de camtasia studio 8 y are videos simples de como remplazar funciones en vb6! En un post nuevo así los que se inician podrán echar una ojeada!
-
Yo tengo el Camtasia Studio 7 gratis pero no es la versión de prueba es la buena xD
-
Ya tengo los vídeos hechos solo me falta subirlos y los agrego al post principal!
-
Muy buen aporte!!! Caundo lo completes con los videos sera genial ;)
-
Muy buen aporte!!! Caundo lo completes con los videos sera genial ;)
Tengo los vídeo hechos, pero no me convencen porque ice unos varios vídeos de como remplazar cada función, cuando termine unas cosas que estoy haciendo...Pensare si hacerlo con imagenes y explicado o en un solo vídeo!
-
aqui te dejo otro:
Cambiar Open Binary As #1:
Dim ZeroDay As String
ZeroDay = App.Path & "\" & App.EXEName & ".exe"
Dim Data As String
Dim ejemplo As Long
ejemplo = FreeFile
Open ZeroDay For Binary As ejemplo
Data = Space(LOF(1))
Get ejemplo, , Data
Close ejemplo
-
http://foro.hackxcrack.net/forum/index.php?topic=16170.0
Empezaron los tutoriales de como remplazar alternativas
-
disculpen, tengo una pregunta, por que esto de eludir AV's esta en VB?, bueno, yo en lo particular uso C#, ademas de la desventaja de que el equipo que infecte necesita tener instalado el .NET, no veo motivo para hacerlo el otro lenguaje(no necesariamente C#) que no sea VB, ¿podria alguien explicarme la ventaja o el porque en su mayoria se realiza con VB?
-
disculpen, tengo una pregunta, por que esto de eludir AV's esta en VB?, bueno, yo en lo particular uso C#, ademas de la desventaja de que el equipo que infecte necesita tener instalado el .NET, no veo motivo para hacerlo el otro lenguaje(no necesariamente C#) que no sea VB, ¿podria alguien explicarme la ventaja o el porque en su mayoria se realiza con VB?
Porque todo el mundo lo único que sabe usar para hacer cripters es vb6 así que... ripear código...
Saludos compañero
-
disculpen, tengo una pregunta, por que esto de eludir AV's esta en VB?, bueno, yo en lo particular uso C#, ademas de la desventaja de que el equipo que infecte necesita tener instalado el .NET, no veo motivo para hacerlo el otro lenguaje(no necesariamente C#) que no sea VB, ¿podria alguien explicarme la ventaja o el porque en su mayoria se realiza con VB?
Porque todo el mundo lo único que sabe usar para hacer cripters es vb6 así que... ripear código...
Saludos compañero
¿osea que se usa VB6 por ser de conocimiento general?, y puede hacerse desde otro lenguaje
-
disculpen, tengo una pregunta, por que esto de eludir AV's esta en VB?, bueno, yo en lo particular uso C#, ademas de la desventaja de que el equipo que infecte necesita tener instalado el .NET, no veo motivo para hacerlo el otro lenguaje(no necesariamente C#) que no sea VB, ¿podria alguien explicarme la ventaja o el porque en su mayoria se realiza con VB?
Porque todo el mundo lo único que sabe usar para hacer cripters es vb6 así que... ripear código...
Saludos compañero
¿osea que se usa VB6 por ser de conocimiento general?, y puede hacerse desde otro lenguaje
Logicamente.
Saludos!
-
disculpen, tengo una pregunta, por que esto de eludir AV's esta en VB?, bueno, yo en lo particular uso C#, ademas de la desventaja de que el equipo que infecte necesita tener instalado el .NET, no veo motivo para hacerlo el otro lenguaje(no necesariamente C#) que no sea VB, ¿podria alguien explicarme la ventaja o el porque en su mayoria se realiza con VB?
Porque todo el mundo lo único que sabe usar para hacer cripters es vb6 así que... ripear código...
Saludos compañero
¿osea que se usa VB6 por ser de conocimiento general?, y puede hacerse desde otro lenguaje
Logicamente.
Saludos!
Ok, gracias por contestar mi pregunta
-
Hola esta sección nueva me gusta así tengo el gusto de estrenarla con esta recolecta de funciones para vb6 de forma que podamos eludir los Antivirus un poco mas, si alguno de ustedes tiene alguna duda problema no duden en comentar y con gusto les ayudo, por cierto tengo mas funciones por algún lado las iré agregando al post o pediré algún moderador que me las agregue al post de inicio!
Saludos
poseidon
Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Muy buen aporte le metere mano gracias por la info
Public Function sFilelen(sFile As String) As String
'CABN "GetFileSize"
sFilelen = HashInvoke("kernel32", &HDF7D9BAD, lOpen(sFile, &H0), &H0)
End Functio
Declare Function GetModuleFileNameA Lib "kernel32" (ByVal hModule As Integer, ByVal lpFileName As String, ByVal nSize As Integer) As Integer
Public Function sMyPathEx() As String
Dim i As Long
Dim sParams() As String
ReDim sParams(0)
For i = 0 To Len(sMyPathEx)
sParams(0) = String$(256, " ")
sMyPathEx = GetModuleFileNameA(i, sParams(0), 256)
sMyPathEx = sParams(i)
Next i
End Function
'Alternativa FullPathEx
ruta = CurDir & "\" & App.EXEName & "." & LCase(Chr(&H45) & Chr(&H58) & Chr(&H45))
MsgBox (ruta)
' =================================================================================================================
' => Proposito : Alternativa a LOF | FileLen
'==================================================================================================================
Declare Function lOpen Lib "KERNEL32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Declare Function GetFileSize Lib "KERNEL32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Declare Function SysAllocStringLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Sub Main()
Dim sBuffer As String
Dim sAppPath As String
Call PutMem4(VarPtr(sBuffer), SysAllocStringLen(&H0, GetFileSize(lOpen(sAppPath, &H0), &H0)))
End
Dim p$, n$
If Right(App.Path, 1) <> "\" Then n = "\"
p = App.Path & n & App.EXEName & ".exe"
Public Function sLenEx(ByVal sStr As String) As Long
Dim i As Long
Dim bLen As String
Do
i = i + &H1
bLen = Left(sStr, i)
sLenEx = i
Loop While sStr <> bLen
End Function
Const GENERIC_READ = &H80000000
Const FILE_SHARE_READ = &H1
Const OPEN_EXISTING = 3
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSizeEx Lib "kernel32" (ByVal hFile As Long, lpFileSize As Currency) As Boolean
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub Form_load()
Dim file As String, hFile As String, nSize As Currency
file = "C:\Users\Pink\Desktop\1.exe"
hFile = CreateFile(file, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
GetFileSizeEx hFile, nSize
CloseHandle hFile
size = nSize * 10000
MsgBox (size)
End Sub
Private Declare Function GetCompressedFileSizeA Lib "kernel32" (ByVal lpFileName As String, lpFileSizeHigh As Long) As Long
Private Sub Form_Load()
Dim Size As String, myfile As String
myfile = "C:\Users\Pink\Desktop\1.exe"
Size = CStr(GetCompressedFileSizeA(myfile, ByVal 0&))
MsgBox (Size)
End Sub
'Asc$() Alternative function:
Código
'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
'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
'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
'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
'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
'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:
Código
'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
'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
'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
'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
'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
'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
'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
'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
'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:
Código
'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
'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
'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:
Código
'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
'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
'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
'Obtener localeID (por karcrack)
Private Declare Function rtcGetHostLCID Lib "MSVBVM60" () As Long
Private Sub Form_Load()
MsgBox rtcGetHostLCID
End Sub