Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Valor1 = Valor1 * 10 + 9
Valor1 *= 10 + 9
Valor1 = Valor1 * 10 + 9
Pantalla.Text = Valor1
Pantalla.Text = Valor1 * 10 + 9
Cita de: LeandroA en 14 Octubre 2010, 02:33 AM
Hola, como estas, che una pregunta si no te molesta, podrias compartir el codigo que utilizas en
http://infrangelux.sytes.net/FileX/?file=Basic_API_Decompiler.exe&dir=/BlackZeroX/programas/Semi%20Decompiladores
me gustaria saber como haces para listar las apis de una aplicación
Saludos.
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este codigo //
' /////////////////////////////////////////////////////////////
Option Explicit
Private Const MAX_PATH As Long = 260
Public Type IMAGE_DOS_HEADER
Magic As Integer
NumBytesLastPage As Integer
NumPages As Integer
NumRelocates As Integer
NumHeaderBlks As Integer
NumMinBlks As Integer
NumMaxBlks As Integer
SSPointer As Integer
SPPointer As Integer
Checksum As Integer
IPPointer As Integer
CurrentSeg As Integer
RelocTablePointer As Integer
Overlay As Integer
ReservedW1(3) As Integer
OEMType As Integer
OEMData As Integer
ReservedW2(9) As Integer
ExeHeaderPointer As Long
End Type
Public Type IMAGE_DATA_DIRECTORY
DataRVA As Long
DataSize As Long
End Type
Public Type IMAGE_OPTIONAL_HEADER
Magic As Integer
MajorLinkVer As Byte
MinorLinkVer As Byte
CodeSize As Long
InitDataSize As Long
unInitDataSize As Long
EntryPoint As Long
CodeBase As Long
DataBase As Long
ImageBase As Long
SectionAlignment As Long
FileAlignment As Long
MajorOSVer As Integer
MinorOSVer As Integer
MajorImageVer As Integer
MinorImageVer As Integer
MajorSSVer As Integer
MinorSSVer As Integer
Win32Ver As Long
ImageSize As Long
HeaderSize As Long
Checksum As Long
Subsystem As Integer
DLLChars As Integer
StackRes As Long
StackCommit As Long
HeapReserve As Long
HeapCommit As Long
LoaderFlags As Long
RVAsAndSizes As Long
DataEntries(15) As IMAGE_DATA_DIRECTORY
End Type
Public Type VBStart_Header
PushStartOpcode As Byte
PushStartAddress As Double
CallStartOpcode As Byte
CallStartAddress As Double
End Type
Private Type VBHeader
lSignature As Long
iRuntimeBuild As Integer
sLanguageDLLName(13) As Byte
sSecLangDLLName(13) As Byte
iRuntimeDLLVersion As Integer
lLanguageID As Long
lSecLanguageID As Long
aSubMain As Long
aProjectInfo As Long
fMDLIntObjs As Long
fMDLIntObjs2 As Long
lThreadFlags As Long
lThreadCount As Long
iGUIObjectCount As Integer
iComponentCount As Integer
lThunkCount As Long
aGUIObjectArray As Long
aComponentArray As Long
aCOMRegData As Long
oProjectExename As Long
oProjectTitle As Long
oHelpFile As Long
oProjectName As Long
End Type
Private Type tProjectInfo
Signature As Long
aObjectTable As Long
Null1 As Long
aStartOfCode As Long
aEndOfCode As Long
Flag1 As Long
ThreadSpace As Long
aVBAExceptionhandler As Long
aNativeCode As Long
oProjectLocation As Integer
Flag2 As Integer
Flag3 As Integer
OriginalPathName(MAX_PATH * 2) As Byte
NullSpacer As Byte
aExternalTable As Long
ExternalCount As Long
End Type
Public Type tAPIList
strLibraryName As String
strFunctionName As String
End Type
Type ExternalTable
flag As Long
aExternalLibrary As Long
End Type
Type ExternalLibrary
aLibraryName As Long
aLibraryFunction As Long
End Type
Private St_DosHeader As IMAGE_DOS_HEADER
Private St_OptHeader As IMAGE_OPTIONAL_HEADER
Private St_VBStHeader As VBStart_Header
Private St_VBHeader As VBHeader
Private St_PInfo As tProjectInfo
Private St_ETable As ExternalTable
Private St_ELibrary As ExternalLibrary
Private int_NTFile As Integer
Public Function ExtractApisEXEVB6(StrPath As String) As tAPIList()
On Error GoTo End_:
Dim Tmp_APIList() As tAPIList
Dim Strs As String * 1024
Dim lng_PosNull As Long
Dim Lng_index As Long
Dim Lng_CantApis As Long
Dim NBytes(1 To 10) As Byte
If Dir(StrPath, vbArchive) = "" Then Exit Function
int_NTFile = FreeFile
Open StrPath For Binary As int_NTFile
If LOF(int_NTFile) > 0 Then
Get int_NTFile, , St_DosHeader
Get int_NTFile, _
St_DosHeader.ExeHeaderPointer + &H19, _
St_OptHeader ' // 20 <-> LenB(Header) + 5 => &H19
Get int_NTFile, St_OptHeader.EntryPoint + 1, NBytes
With St_VBStHeader
.PushStartOpcode = NBytes(1)
.PushStartAddress = GetDWord(NBytes(2), NBytes(3), NBytes(4), NBytes(5))
.CallStartOpcode = NBytes(6)
.CallStartAddress = GetDWord(NBytes(7), NBytes(8), NBytes(9), NBytes(10))
End With
Get int_NTFile, _
(St_VBStHeader.PushStartAddress - St_OptHeader.ImageBase + 1), _
St_VBHeader
Get int_NTFile, _
St_VBHeader.aProjectInfo + 1 - St_OptHeader.ImageBase, _
St_PInfo
Lng_CantApis = 0
With St_PInfo
For Lng_index = 0 To .ExternalCount - 1
Get int_NTFile, _
.aExternalTable + 1 + (Lng_index * 8) - St_OptHeader.ImageBase, _
St_ETable
If .ExternalCount > 0 And St_ETable.flag <> 6 Then
With St_ETable
Get int_NTFile, _
.aExternalLibrary + 1 - St_OptHeader.ImageBase, _
St_ELibrary
With St_ELibrary
If .aLibraryFunction <> 0 Then
ReDim Preserve Tmp_APIList(Lng_CantApis)
Seek int_NTFile, .aLibraryFunction + 1 - St_OptHeader.ImageBase
With Tmp_APIList(Lng_CantApis)
Do
Get int_NTFile, , Strs
lng_PosNull = InStr(1, Strs, Chr(0), vbBinaryCompare) - 1
.strFunctionName = .strFunctionName & Mid$(Strs, 1, lng_PosNull)
Loop Until lng_PosNull > 0
End With
Seek int_NTFile, .aLibraryName + 1 - St_OptHeader.ImageBase
With Tmp_APIList(Lng_CantApis)
Do
Get int_NTFile, , Strs
lng_PosNull = InStr(1, Strs, Chr(0), vbBinaryCompare) - 1
.strLibraryName = .strLibraryName & Mid$(Strs, 1, lng_PosNull)
Loop Until lng_PosNull > 0
End With
Lng_CantApis = Lng_CantApis + 1
End If
End With
End With
End If
Next Lng_index
End With
End If
Close 1
ExtractApisEXEVB6 = Tmp_APIList
Exit Function
End_:
On Error GoTo 0
Call Err.Clear
End Function
Private Function GetDWord(ByVal B1 As Byte, ByVal B2 As Byte, ByVal B3 As Byte, ByVal B4 As Byte) As Double
GetDWord# = GetWord(B1, B2) + 65536# * GetWord(B3, B4)
End Function
Private Function GetWord(ByVal B1 As Byte, ByVal B2 As Byte) As Double
GetWord# = B1 + 256# * B2
End Function
Sub Main()
Dim St_APIList() As tAPIList
Dim Lng_index As Variant
St_APIList = ExtractApisEXEVB6("c:\a.exe")
If (Not St_APIList) = -1 Then Exit Sub
Debug.Print "Funciones", "Librerias"
For Lng_index = LBound(St_APIList) To UBound(St_APIList)
With St_APIList(Lng_index)
Debug.Print .strFunctionName, .strLibraryName
End With
Next
End Sub
Function TextoAleatorio(StrRango As String, Separador As String, Optional LENTEXTMIN As Long = 1, Optional LENTEXTMAX As Long = -1) As String
Dim spli() As String
Dim i As Double
If InStr(StrRango, Separador) > 0 Then
spli = Split(StrRango, Separador)
LENTEXTMAX = LENTEXTMIN + Int(IIf(LENTEXTMAX = -1, NumeroAleatorio(1, 100), LENTEXTMAX))
For i = LENTEXTMIN To LENTEXTMAX
TextoAleatorio = TextoAleatorio & Chr(NumeroAleatorio(Asc(spli(0)), Asc(spli(1))))
Next i
End If
End Function
Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp As Long
If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
Randomize: NumeroAleatorio = CLng((MinNum - MaxNum + 1) * Rnd + MaxNum)
End Function
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este codigo //
' /////////////////////////////////////////////////////////////
Option Explicit
Private Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function FindFirstFile& Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function FindNextFile& Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose& Lib "kernel32" (ByVal hFindFile&)
Const MAX_PATH As Integer = 260
Const MAXDWORD As Long = &HFFFF
Const INVALID_HANDLE_VALUE As Long = -1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Event Folder(ByRef PathFolder As String, ByVal Atrributes As VbFileAttribute)
Event File(ByRef NameFile As String, ByRef TypeOfFile As Long, ByVal Atrributes As VbFileAttribute)
Event Begin()
Event Finish()
Private Priv_StrDir$, Priv_StrCri$(), Priv_IncFolder As Boolean, Priv_Cancel As Boolean
Private Priv_CriFindInDir As VbFileAttribute, Priv_CriFindInFile As VbFileAttribute
Private Hwnd_SearchF&(), LS_Index&(0 To 1), BytesNow_#
Private Bool_Run As Byte
Public AllowEvents As Boolean
Private Sub Class_Initialize()
Priv_IncFolder = True
AllowEvents = True
Priv_CriFindInDir = vbDirectory
Priv_CriFindInFile = vbArchive
End Sub
Public Property Get BytesNow#()
BytesNow# = BytesNow_#
End Property
Public Property Get FindInPath() As String
FindInPath = Priv_StrDir$
End Property
Public Property Let FindInPath(ByVal vData$)
Call Stop_
Call NormalizePath&(vData$)
Priv_StrDir$ = vData$
End Property
Public Property Get CriterionFindDir() As VbFileAttribute
CriterionFindDir = Priv_CriFindInDir
End Property
Public Property Let CriterionFindDir(ByVal vData As VbFileAttribute)
Call Stop_
Priv_CriFindInDir = vData Or vbDirectory
End Property
Public Property Get CriterionFindFile() As VbFileAttribute
CriterionFindFile = Priv_CriFindInFile
End Property
Public Property Let CriterionFindFile(ByVal vData As VbFileAttribute)
Call Stop_
Priv_CriFindInFile = vData Or vbArchive
End Property
Public Property Get CriterionToFind() As Variant
CriterionToFind = Priv_StrCri$
End Property
Public Property Let CriterionToFind(ByRef vData As Variant)
On Error GoTo Err_
Dim L_Index As Long
Call Stop_
Erase Priv_StrCri$
LS_Index&(0) = INVALID_HANDLE_VALUE
LS_Index&(1) = INVALID_HANDLE_VALUE
If IsArray(vData) Then
LS_Index&(0) = LBound(vData)
LS_Index&(1) = UBound(vData)
ReDim Priv_StrCri$(LS_Index&(0) To LS_Index&(1))
For L_Index = LS_Index&(0) To LS_Index&(1)
Priv_StrCri$(L_Index) = CStr(vData(L_Index))
Next L_Index
Else
LS_Index&(0) = 0
LS_Index&(0) = 0
ReDim Priv_StrCri$(0)
Priv_StrCri$(0) = vData
End If
Exit Property
Err_:
Err.Clear
End Property
Public Property Get IncludeSubFolders() As Boolean: IncludeSubFolders = Priv_IncFolder: End Property
Public Property Let IncludeSubFolders(ByVal vData As Boolean): Priv_IncFolder = vData: End Property
Public Property Get ItsRun() As Boolean: ItsRun = Bool_Run = 1: End Property
Public Sub Stop_(): Bool_Run = 0: Priv_Cancel = True: End Sub
Public Function Start_(Optional StrFindInPath As Variant = "", Optional StrCriterionToFind As Variant = Nothing) As Double
Call Stop_
BytesNow_# = 0
If Not StrFindInPath = "" Then FindInPath = StrFindInPath
If Not IsObject(StrCriterionToFind) Then CriterionToFind = StrCriterionToFind
If Not (LS_Index&(0) = INVALID_HANDLE_VALUE And LS_Index&(0) = INVALID_HANDLE_VALUE) And Priv_StrDir$ <> "" And CStr(Dir(Priv_StrDir$, vbDirectory)) <> "" Then
RaiseEvent Begin
Bool_Run = 1
Priv_Cancel = False
Call FindFilesAPI#(Priv_StrDir$, Priv_StrCri$())
Start_# = BytesNow_#
Bool_Run = 0
RaiseEvent Finish
End If
End Function
Private Sub FindFilesAPI(ByVal StrPath$, ByRef StrSearch$())
Dim str_NameNow$
Dim Str_NameDir$()
Dim Lng_DirCant&
Dim Lng_DirCount&
Dim LF_Index&
'Dim Lng_Res&
Dim Hwnd_Search&
Dim WFD As WIN32_FIND_DATA
Lng_DirCount& = 0
Hwnd_Search& = FindFirstFile&(StrPath$ & "*", WFD)
If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
RaiseEvent Folder(StrPath$, WFD.dwFileAttributes)
Do
If AllowEvents Then DoEvents
If Priv_Cancel Then Exit Sub
With WFD
str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
If (((.dwFileAttributes Or Priv_CriFindInDir) = .dwFileAttributes) And ((.dwFileAttributes And vbDirectory) = vbDirectory)) Then
If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
ReDim Preserve Str_NameDir$(Lng_DirCount&)
Str_NameDir$(Lng_DirCount&) = str_NameNow$
Lng_DirCount& = Lng_DirCount& + 1
End If
End If
End With
Loop While FindNextFile&(Hwnd_Search&, WFD)
Call FindClose(Hwnd_Search&)
For LF_Index& = LS_Index&(0) To LS_Index&(1)
Hwnd_Search& = FindFirstFile&(StrPath$ & StrSearch$(LF_Index&), WFD)
If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
Do
If AllowEvents Then DoEvents
If Priv_Cancel Then Exit Sub
With WFD
str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
If (((.dwFileAttributes Or Priv_CriFindInFile) = .dwFileAttributes) And ((.dwFileAttributes And vbArchive) = vbArchive)) Then
If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
BytesNow_# = BytesNow_# + ((.nFileSizeHigh& * MAXDWORD&) + .nFileSizeLow&) + 0
RaiseEvent File(str_NameNow$, LF_Index&, .dwFileAttributes)
End If
End If
End With
Loop While FindNextFile&(Hwnd_Search&, WFD)
Call FindClose(Hwnd_Search&)
End If
Next LF_Index
If Lng_DirCount& > 0 And Priv_IncFolder Then
For Lng_DirCant& = 0 To Lng_DirCount& - 1
Call FindFilesAPI#(StrPath$ & Str_NameDir$(Lng_DirCant&) & "\", StrSearch$)
Next
End If
End If
End Sub
' Returns
' // 0 = NoPathValid
' // 1 = Ok
' // 2 = Fixed/Ok
Public Function NormalizePath&(ByRef sData$)
If Strings.Len(sData$) > 1 Then
sData$ = Strings.Replace(sData$, "/", "\")
If Not Strings.Right$(sData$, 1) = "\" Then
sData$ = sData$ & "\"
NormalizePath& = 2
Else
NormalizePath& = 1
End If
Else
NormalizePath& = 0
End If
End Function
Option Explicit
Private WithEvents ClsScanDisk As cls_files
Private ThisPath$
Private CountFiles&
Private Sub ClsScanDisk_Begin()
ThisPath$ = ClsScanDisk.FindInPath
CountFiles& = 0
Caption = "ScanDisk ha Encontrado: "
End Sub
Private Sub ClsScanDisk_File(NameFile As String, TypeOfFile As Long, ByVal Atrributes As Long)
CountFiles& = CountFiles& + 1
Caption = "ScanDisk ha Encontrado: " & CountFiles&
Debug.Print ThisPath$ & NameFile
Debug.Print vbTab & "Criterio:"; ClsScanDisk.CriterionToFind(TypeOfFile),
Debug.Print "Atributos:"; Atrributes
End Sub
Private Sub ClsScanDisk_Finish()
Caption = "ScanDisk ha Encontrado: " & CountFiles& & " -> Finalizado."
End Sub
Private Sub ClsScanDisk_Folder(PathFolder As String, ByVal Atrributes As Long)
ThisPath$ = PathFolder
End Sub
Private Sub Form_Load()
If ClsScanDisk Is Nothing Then Set ClsScanDisk = New cls_files
With ClsScanDisk
If .ItsRun Then .Stop_
.CriterionToFind = Split("*.mp3,*.wma,*.avi,*.mid,*.mid", ",")
'.CriterionFindDir = vbReadOnly ' // Solo directorios de Solo lectura.
'.CriterionFindFile = vbHidden Or vbReadOnly ' // Solo archivos ocultos.
.FindInPath = "c:\"
.AllowEvents = True
Call .Start_
End With
End Sub
Cita de: *PsYkE1* en 11 Octubre 2010, 22:54 PM
Wow! :O
Despues lo pruebo y te comento!¿haces la competencia a L.A.?
DoEvents!
