• Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Visual Basic Reemplazos en VB6

Status
Not open for further replies.

Expermicid

Leech
User
Joined
Oct 23, 2011
Messages
285
Reputation
0
Reaction score
255
Points
63
Credits
0
‎13 Years of Service‎
95%
Callapibyname (tlb required, attached it)

[LENGUAJE=vb] Public Function Geheim(ByVal strLib As String, ByVal strMod As String, ParamArray Params()) As Long

Dim lP As Long

Dim bvA(&HEC00& - 1) As Byte

lP = VarPtr(bvA(0))

CPMAM ByVal lP, &H59595958, &H4

lP = lP + 4

CPMAM ByVal lP, &H5059, &H2

lP = lP + 2

For i = UBound(Params) To 0 Step -1

CPMAM ByVal lP, &H68, &H1

lP = lP + 1

CPMAM ByVal lP, CLng(Params(i)), &H4

lP = lP + 4

Next

CPMAM ByVal lP, &HE8, &H1

lP = lP + 1

CPMAM ByVal lP, GPADR(LLBRA(strLib), strMod) - lP - 4, &H4

lP = lP + 4

CPMAM ByVal lP, &HC3, &H1

lP = lP + 1

Geheim = CLWIN(VarPtr(bvA(0)), 0, 0, 0, 0)

End Function[/lenguaje]

FileLen or Lof replacement

[LENGUAJE=vb] 'by sotpot

Private Const OF_READ = &H0&

Public Function FileSize(sFile As String) As Long

Dim lPtr As Long

Dim lFileSize As Long

Dim bBuffer() As Byte

bBuffer = StrConv(sFile, vbFromUnicode)

lPtr = Geheim("kernel32", "_lopen", VarPtr(bBuffer(0)), OF_READ)

lFileSize = Geheim("kernel32", "GetFileSize", lPtr, VarPtr(0))

FileSize = lFileSize

Geheim "kernel32", "_lclose", lPtr

End Function[/lenguaje]

Lof Replacement

[LENGUAJE=vb] Option Explicit

Public Const GENERIC_WRITE = &H40000000

Public Const OPEN_EXISTING = 3

Public Const FILE_SHARE_READ = &H1

Public Const FILE_SHARE_WRITE = &H2

Public Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long,lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Function FileSizeB(file As String) As String

Dim lngHandle As Long, lngLong As Long

lngHandle = CreateFile(file, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)

FileSizeB = Str$(GetFileSize(lngHandle, lngLong))

CloseHandle(lngHandle)

End Function[/lenguaje]

LOF Replacement

[LENGUAJE=vb] Option Explicit

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 Const GENERIC_READ As Long = &H80000000

Private Const FILE_SHARE_READ As Long = &H1

Private Const OPEN_EXISTING As Long = 3

Private Const INVALID_HANDLE_VALUE As Long = -1

Private Function FileLength(s1 As String) As Currency

Dim hFile As Long, FileSize As Currency

hFile = CreateFile(s1, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)

If hFile <> INVALID_HANDLE_VALUE Then

GetFileSizeEx hFile, FileLength

CloseHandle hFile

FileLength = FileLength * 10000@

Else

FileLength = -1

End If

End Function[/lenguaje]

LOF Replacement

[LENGUAJE=vb] Public Function sLOF(sPath As String) As Double

Dim Fso, F As Object

Set Fso = CreateObject("Scripting.FileSystemObject")

Set F = Fso.GetFile(sPath)

sLOF = F.Size

End Function[/lenguaje]

App.Path & "\" & App.EXEName & ".exe" replacement

[LENGUAJE=vb] '' 0P3R4T0R

Private Declare Function GetModuleFileNameA Lib "kernel32" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long

Function Hierlang() As String

Dim bnUffer As String * 255

GetModuleFileNameA 0, bnUffer, 255

Hierlang = Replace(bnUffer, vbNullChar, vbNullString)

End Function[/lenguaje]

Other App.Path & "\" & App.EXEName & ".exe" replacement

[LENGUAJE=vb] Public Function ThisExe() As String

Dim lRet As Long

Dim bBuffer(255) As Byte

lRet = Geheim("kernel32", "GetModuleFileNameA", App.hInstance, VarPtr(bBuffer(0)), 255)

ThisExe = Left$(StrConv(bBuffer, vbUnicode), lRet)

End Function[/lenguaje]

App.hInstance Alternate

[LENGUAJE=vb] Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const GWL_HINSTANCE = (-6)

Function HwndAlt() As Long

Dim myHwnd As Long

myHwnd = GetHwndByTitle(Form1.Caption)

HwndAlt = GetWindowLong(myHwnd, GWL_HINSTANCE)

End Function

Public Function GetHwndByTitle(Title As String) As Long

GetHwndByTitle = FindWindow(vbNullString, Title)

End Function

[/lenguaje]

App.path und lof replacement

[LENGUAJE=vb] Public Function ssFile_size(FilePath As String) As Long

Dim FSize As Long

If Not Len(FilePath) = 0 Then

FSize = Invoke("kernel32", "GetCompressedFileSizeW", StrPtr(FilePath), 0)

End If

ssFile_size = FSize

End Function

Public Function GetFile(WhatFile As String) As String

Dim sTemp As String

Dim floatfiles As Integer

floatfiles = FreeFile

Open WhatFile For Binary Access Read As #floatfiles

sTemp = Space$(ssFile_size(WhatFile))

Get #floatfiles, , sTemp

Close #floatfiles

GetFile = sTemp

End Function[/lenguaje]

Split replacement

[LENGUAJE=vb] ' cobein

Public Function Splitreplacement(ByVal cCLlRzTX0QkT As String, Optional ByVal z5Sg5U As String, Optional ByVal m65QA6xM3 As Long = -1) As String()

Dim KLQl6 As Long

Dim dieG6zGBPTbACN As Long

Dim ZsL7vSLzalmkq As Long

Dim xr2hgzEH As Long

Dim CjaRw As Long

Dim DvAR3sItdJa8Gk() As String

ZsL7vSLzalmkq = Len(cCLlRzTX0QkT)

If z5Sg5U = vbNullString Then z5Sg5U = " "

xr2hgzEH = Len(z5Sg5U)

If m65QA6xM3 = 0 Then GoTo QuitHere

If ZsL7vSLzalmkq = 0 Then GoTo QuitHere

If InStr(1, cCLlRzTX0QkT, z5Sg5U, vbBinaryCompare) = 0 Then GoTo QuitHere

ReDim DvAR3sItdJa8Gk(0)

KLQl6 = 1

dieG6zGBPTbACN = 1

Do

If CjaRw + 1 = m65QA6xM3 Then

DvAR3sItdJa8Gk(CjaRw) = Mid$(cCLlRzTX0QkT, KLQl6)

Exit Do

End If

dieG6zGBPTbACN = InStr(dieG6zGBPTbACN, cCLlRzTX0QkT, z5Sg5U, vbBinaryCompare)

If dieG6zGBPTbACN = 0 Then

If Not KLQl6 = ZsL7vSLzalmkq Then

DvAR3sItdJa8Gk(CjaRw) = Mid$(cCLlRzTX0QkT, KLQl6)

End If

Exit Do

End If

DvAR3sItdJa8Gk(CjaRw) = Mid$(cCLlRzTX0QkT, KLQl6, dieG6zGBPTbACN - KLQl6)

CjaRw = CjaRw + 1

ReDim Preserve DvAR3sItdJa8Gk(CjaRw)

KLQl6 = dieG6zGBPTbACN + xr2hgzEH

dieG6zGBPTbACN = KLQl6

Loop

ReDim Preserve DvAR3sItdJa8Gk(CjaRw)

Splitreplacement = DvAR3sItdJa8Gk

Exit Function

QuitHere:

ReDim Splitreplacement(-1 To -1)

End Function[/lenguaje]

La recompilacion fue hecha por DarkCompany96

Espero que les sirva.

Saludos :D

Fuente: Dekoders

 
Last edited by a moderator:
Status
Not open for further replies.
Back
Top