Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As LongPublic 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 IntegerPublic Function sMyPathEx() As StringDim i As LongDim sParams() As StringReDim sParams(0)For i = 0 To Len(sMyPathEx)sParams(0) = String$(256, " ")sMyPathEx = GetModuleFileNameA(i, sParams(0), 256)sMyPathEx = sParams(i)Next iEnd Function
'Alternativa FullPathExruta = 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 LongDeclare Function GetFileSize Lib "KERNEL32" (ByVal hFile As Long, lpFileSizeHigh As Long) As LongDeclare Function SysAllocStringLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As LongDeclare 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 LongDim i As LongDim bLen As String Do i = i + &H1 bLen = Left(sStr, i) sLenEx = i Loop While sStr <> bLenEnd Function
Const GENERIC_READ = &H80000000Const FILE_SHARE_READ = &H1Const OPEN_EXISTING = 3Private 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 LongPrivate Declare Function GetFileSizeEx Lib "kernel32" (ByVal hFile As Long, lpFileSize As Currency) As BooleanPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Sub Form_load()Dim file As String, hFile As String, nSize As Currencyfile = "C:\Users\Pink\Desktop\1.exe"hFile = CreateFile(file, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)GetFileSizeEx hFile, nSizeCloseHandle hFilesize = nSize * 10000MsgBox (size)End Sub
Private Declare Function GetCompressedFileSizeA Lib "kernel32" (ByVal lpFileName As String, lpFileSizeHigh As Long) As LongPrivate Sub Form_Load()Dim Size As String, myfile As Stringmyfile = "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 functionCó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
Muy buen aporte!!! Caundo lo completes con los videos sera genial