|
Mostrar Mensajes
|
Páginas: 1 [2] 3 4 5
|
12
|
Programación / Programación Visual Basic / Re: [Proyecto]Facebook Photo Uploader
|
en: 13 Marzo 2011, 04:00 am
|
Hola la verdad no entiendo el codigo y me cierra todo con error cuando llamo a InitCurrentThread
como aplicas eso con las apis de inet?
Llama la función CreateNewThread pasandole el puntero a una funcion donde se iniciará el nuevo hilo, al inicio de esa funcion llama InitCurrentThread y luego hace las llamadas que quieras, todo eso será en un nuevo thread, recorda usar vbModal cuando vas a mostrar forms y lo que dije anteriormente pon Sub Main como objeto inicial y desde ahi inicia el/los forms normalmenteSaludos
|
|
|
13
|
Programación / Programación Visual Basic / [SNIPPET-VB6] DrawGraph - Dibujar sobre controles.
|
en: 12 Marzo 2011, 14:48 pm
|
Lo hice hace ya un tiempo para hacer poner imágenes en los commandbutton y que queden en la misma linea, pero se puede aplicar a cualquier control. Option Explicit Private Const WM_PAINT As Long = &HF Private Const GWL_WNDPROC = -4 Private Type DRAW_DATA DrawPic As PictureBox DrawTop As Long DrawLeft As Long lpPrevWndProc As Long ControlHwnd As Long ControlDC As Long End Type Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetDC Lib "USER32" (ByVal Hwnd As Long) As Long Private Declare Function GdiTransparentBlt Lib "GDI32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean Private DrawArray() As DRAW_DATA Public Sub DrawGraph(Hwnd As Long, Pic As PictureBox, Top As Long, Left As Long) Dim i As Long If Not Not DrawArray Then: i = UBound(DrawArray) + 1 ReDim Preserve DrawArray(i) With DrawArray(i) Set .DrawPic = Pic .DrawPic.BorderStyle = 0 .DrawPic.ScaleMode = vbPixels .DrawPic.BackColor = &HFF00FF .DrawPic.AutoSize = True .DrawPic.Refresh .ControlHwnd = Hwnd .lpPrevWndProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf ControlProc) .ControlDC = GetDC(Hwnd) .DrawTop = Top: .DrawLeft = Left End With End Sub Public Sub UnDrawGraph(ByVal Hwnd As Long) Dim i As Long For i = 0 To UBound(DrawArray) If DrawArray(i).ControlHwnd = Hwnd Then Call SetWindowLong(Hwnd, GWL_WNDPROC, DrawArray(i).lpPrevWndProc) End If Next i End Sub Private Function ControlProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim i As Long For i = 0 To UBound(DrawArray) With DrawArray(i) If .ControlHwnd = Hwnd Then ControlProc = CallWindowProc(.lpPrevWndProc, Hwnd, Msg, wParam, lParam) If (Msg = WM_PAINT) Then Call GdiTransparentBlt(.ControlDC, .DrawLeft, .DrawTop, .DrawPic.ScaleWidth, .DrawPic.ScaleHeight, .DrawPic.hdc, 0, 0, .DrawPic.ScaleWidth, .DrawPic.ScaleHeight, &HFF00FF) End If End If End With Next i End Function
|
|
|
14
|
Programación / Programación Visual Basic / [VB6] ProgressBarInListView
|
en: 12 Marzo 2011, 14:07 pm
|
mProgressBarInListView:Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Const LVM_FIRST As Long = &H1000 Private Const LVM_GETSUBITEMRECT As Long = (LVM_FIRST + 56) Private Const LVIR_LABEL As Long = 2 Private Const WM_NOTIFY As Long = &H4E Private Const WM_HSCROLL As Long = &H114 Private Const WM_VSCROLL As Long = &H115 Private Const WM_KEYDOWN As Long = &H100 Private Const HDN_FIRST As Long = (0 - 300) Private Const HDN_ENDTRACK As Long = (HDN_FIRST - 1) Private Declare Function SendMessageA Lib "USER32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SetParent Lib "USER32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function SetWindowLongA Lib "USER32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function CallWindowProcA Lib "USER32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private lpPrevWndProc As Long Private Function ListView_GetSubItemRect(ByVal hWndLV As Long, ByVal iItem As Long, ByVal iSubItem As Long, ByVal code As Long, lpRect As RECT) As Boolean lpRect.Top = iSubItem lpRect.Left = code ListView_GetSubItemRect = SendMessageA(hWndLV, LVM_GETSUBITEMRECT, ByVal iItem, lpRect) End Function Public Sub PutProgressBarInListView(ListView As ListView, InColumn As Long) Dim i As Long For i = 0 To ListView.ListItems.Count - 1 If i > Form1.ProgressBar1.Count - 1 Then: Call Load(Form1.ProgressBar1(i)) Call SetParent(Form1.ProgressBar1(i).hWnd, ListView.hWnd) Next Call AdjustProgressBar(ListView, InColumn) lpPrevWndProc = SetWindowLongA(ListView.hWnd, -4, AddressOf ListViewProc) End Sub Public Sub AdjustProgressBar(ListView As ListView, InColumn As Long) Dim Pos As RECT Dim i As Long For i = 0 To Form1.ProgressBar1.Count - 1 Call ListView_GetSubItemRect(ListView.hWnd, i, InColumn, LVIR_LABEL, Pos) With Form1.ProgressBar1(i) .Left = (Pos.Left) * Screen.TwipsPerPixelX .Width = (Pos.Right - Pos.Left) * Screen.TwipsPerPixelX .Height = ((Pos.Bottom - Pos.Top) * Screen.TwipsPerPixelY) .Top = Pos.Top * Screen.TwipsPerPixelY + ((Pos.Bottom - Pos.Top) * Screen.TwipsPerPixelY - .Height) / 2 Call IIf(Pos.Top <= 3, .Visible = False, .Visible = True) End With Next End Sub Private Function ListViewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim Param As Long Dim bAdjust As Boolean Select Case Msg Case WM_HSCROLL, WM_VSCROLL: bAdjust = True Case WM_KEYDOWN Select Case wParam Case 33 To 40: bAdjust = True End Select Case WM_NOTIFY Call CopyMemory(Param, ByVal lParam + 8, 4) If Param = HDN_ENDTRACK Then: bAdjust = True End Select If bAdjust = True Then: Call AdjustProgressBar(Form1.ListView1, 1) ListViewProc = CallWindowProcA(lpPrevWndProc, hWnd, Msg, wParam, lParam) End Function
Simplemente necesitaba hacer esto y lo comparto, espero que le sirva a alguien
|
|
|
15
|
Programación / Programación Visual Basic / Re: [Proyecto]Facebook Photo Uploader
|
en: 11 Marzo 2011, 18:01 pm
|
@F3B14N si seria lo correcto, pero la verdad no le tengo mucha fe a vb con el uso de threads seria un gran dolor de cabeza. Option Explicit Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Declare Function VirtualProtect Lib "KERNEL32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long Private Declare Function CreateThread Lib "KERNEL32" (ByVal lpSecurityAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long Private Declare Function ReadProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long Private Declare Function VBDllGetClassObject Lib "MSVBVM60" (g1 As Long, g2 As Long, ByVal g3_vbHeader As Long, REFCLSID As Long, REFIID As GUID, ppv As Long) As Long Private Declare Function CreateIExprSrvObj Lib "MSVBVM60" (ByVal p1_0 As Long, ByVal p2_4 As Long, ByVal p3_0 As Long) As Long Private Declare Function CoInitialize Lib "OLE32" (ByVal pvReserved As Long) As Long Private Declare Sub CoUninitialize Lib "OLE32" () Private VBHeaderAddress As Long Private MainAddress As Long Public Sub CreateNewThread(ByVal lAddress As Long, ByVal lVal As Long, Optional ByRef lHandle As Long, Optional ByRef lThread As Long) If VBHeaderAddress = 0 Then Call GetFakeHeader: Call GetMainAddress Call VirtualProtect(ByVal MainAddress, 1, &H40, 0&) End If lHandle = CreateThread(ByVal 0&, ByVal 0&, lAddress, ByVal lVal, 0, lThread) End Sub Public Sub InitCurrentThread() Call CreateIExprSrvObj(0, 4, 0) Call CoInitialize(0) Call InitDLL End Sub Public Sub TerminateCurrentThread() Call CoUninitialize End Sub Public Sub GetFakeHeader() Dim lPtr As Long Dim lProc As Long Dim bData(1024) As Byte Dim sData As String Dim lRet As Long lPtr = App.hInstance Do While lRet = 0 Call ReadProcessMemory(-1, ByVal lPtr, bData(0), 1024, 0&) sData = StrConv(bData, vbUnicode) lRet = InStr(1, sData, "VB5!", vbBinaryCompare) lPtr = lPtr + 1024 Loop VBHeaderAddress = lPtr + lRet - 1024 - 1 End Sub Private Sub GetMainAddress() Call ReadProcessMemory(-1, ByVal VBHeaderAddress + &H2C, MainAddress, 4, 0&) 'If MainAddress = 0 Then ' 'MainAddress = AddressOf Private Sub Form_Initialize() 'End If End Sub Private Sub InitDLL() Dim pIID As GUID With pIID .Data1 = 1 .Data4(0) = &HC0 .Data4(7) = &H46 End With Call ReadProcessMemory(-1, &HC3, ByVal MainAddress, 4, 0&) Call VBDllGetClassObject(0, 0, VBHeaderAddress, 0, pIID, 0) Call ReadProcessMemory(-1, &H8B, ByVal MainAddress, 4, 0&) End Sub Private Sub Main() CLIENT_Main.Show End Sub
Funciona sin problemas, simplemente pon Sub Main como objeto inicial y desde ahi inicia el/los forms normalmente. Recorda llamar InitCurrentThread en cada nuevo thread también.
|
|
|
16
|
Programación / Programación Visual Basic / Re: AddressOf Form_Initialize()
|
en: 9 Marzo 2011, 21:47 pm
|
Gracias, pero aún sigo sin lograr lo que busco, seguiré intentandolo Aca dejo las estructuras y poco mas para quienes las puedan necesitar: Private Type VBHeader szVbMagic As Long '0x00, VB5! String wRuntimeBuild As Integer '0x04, Build of the VB6 Runtime szLangDll(13) As Byte '0x06, Language Extension DLL szSecLangDll(13) As Byte '0x14, Language Extension DLL wRuntimeRevision As Integer '0x22, Internal Runtime Revision dwLcid As Long '0x24, LCID of Language DLL dwSecLCID As Long '0x28, LCID of 2nd Language DLL lpSubMain As Long '0x2C, Pointer to Sub Main Code lpProjectData As Long '0x30, Pointer to Project Data fMdlIntCtls As Long '0x34, VB Control Flags for IDs < 32 fMdlIntCtls2 As Long '0x38, VB Control Flags for IDs > 32 dwThreadFlags As Long '0x3C, Threading Mode dwThreadCount As Long '0x40, Threads to support in pool wFormCount As Long '0x44, Number of forms present wExternalCount As Integer '0x46, Number of external controls dwThunkCount As Long '0x48, Number of thunks to create lpGuiTable As Long '0x4C, Pointer to GUI Table lpExternalTable As Long '0x50, Pointer to External Table lpComRegisterData As Long '0x54, Pointer to COM Information bSZProjectDescription As Long '0x58, Offset to Project Description bSZProjectExeName As Long '0x5C, Offset to Project EXE Name bSZProjectHelpFile As Long '0x60, Offset to Project Help File bSZProjectName As Long '0x64, Offset to Project Name End Type Private Type COMRegistrationData bRegInfo As Long '0x00, Offset to COM Interfaces Info bSZProjectName As Long '0x04, Offset to Project/Typelib Name bSZHelpDirectory As Long '0x08, Offset to Help Directory bSZProjectDescription As Long '0x0C, Offset to Project Description uuidProjectClsId(15) As Byte ' 0x10, CLSID of Project/Typelib dwTlbLcid As Long '0x20, LCID of Type Library wUnknown As Integer '0x24, Might be something. Must check wTlbVerMajor As Integer '0x26, Typelib Major Version End Type Private Type COMRegistrationInfo bNextObject As Long '0x00, Offset to COM Interfaces Info bObjectName As Long '0x04, Offset to Object Name bObjectDescription As Long '0x08, Offset to Object Description dwInstancing As Long '0x0C, Instancing Mode dwObjectId As Long '0x10, Current Object ID in the Project uuidObject(15) As Byte '0x14, CLSID of Object fIsInterface As Long '0x24, Specifies if the next CLSID is valid bUuidObjectIFace As Long '0x28, Offset to CLSID of Object Interface bUuidEventsIFace As Long '0x2C, Offset to CLSID of Events Interface fHasEvents As Long '0x30, Specifies if the CLSID above is valid dwMiscStatus As Long '0x34, OLEMISC Flags (see MSDN docs) fClassType As Byte '0x38, Class Type fObjectType As Byte '0x39, Flag identifying the Object Type wToolboxBitmap32 As Integer '0x3A, Control Bitmap ID in Toolbox wDefaultIcon As Integer '0x3C, Minimized Icon of Control Window fIsDesigner As Integer ' 0x3E, Specifies whether this is a Designer bDesignerData As Long '0x40, Offset to Designer Data End Type Private Type DesignerInfo uuidDesigner(15) As Byte '0x00, CLSID of the Addin/Designer cbStructSize As Long '0x10, Total Size of the next fields. ' ea = ea + 0x18; ' MakeDword (ea - 0x04 'bstrAddinRegKey FixStr (ea, Registry Key of the Addin ' ea = ea + 0x04 + Dword(ea - 0x04 ' MakeDword (ea - 0x04 'bstrAddinName FixStr (ea, Friendly Name of the Addin ' ea = ea + 0x04 + Dword(ea - 0x04 ' MakeDword (ea - 0x04 'bstrAddinDescription FixStr (ea, Description of Addin ' ea = ea + Dword(ea - 0x04 'dwLoadBehaviour FixDword (ea, CLSID of Object ' ea = ea + 0x08; ' MakeDword (ea - 0x04 'bstrSatelliteDll FixStr (ea, Satellite DLL, if specified ' ea = ea + 0x04 + Dword(ea - 0x04 ' MakeDword (ea - 0x04 'bstrAdditionalRegKey FixStr (ea, Extra Registry Key, if specified ' ea = ea + Dword(ea - 0x04 'dwCommandLineSafe FixDword (ea, Specifies a GUI-less Addin if 1. End Type Private Type ProjectInformation dwVersion As Long '0x00, 5.00 in Hex (0x1F4). Version. lpObjectTable As Long '0x04, Pointer to the Object Table dwNull As Long '0x08, Unused value after compilation. lpCodeStart As Long '0x0C, Points to start of code. Unused. lpCodeEnd As Long '0x10, Points to end of code. Unused. dwDataSize As Long '0x14, Size of VB Object Structures. Unused. lpThreadSpace As Long '0x18, Pointer to Pointer to Thread Object. lpVbaSeh As Long '0x1C, Pointer to VBA Exception Handler lpNativeCode As Long '0x20, Pointer to .DATA section. szPathInformation(527) As Byte '0x24, Contains Path and ID string. < SP6 lpExternalTable As Long '0x234, Pointer to External Table. dwExternalCount As Long '0x238, Objects in the External Table. End Type Private Type SecondaryProjectInformation lpHeapLink As Long '0x00, Unused after compilation, always 0. lpObjectTable As Long '0x04, Back-Pointer to the Object Table. dwReserved As Long '0x08, Always set to -1 after compiling. Unused dwUnused As Long '0x0C, Not written or read in any case. lpObjectList As Long '0x10, Pointer to Object Descriptor Pointers. dwUnused2 As Long '0x14, Not written or read in any case. szProjectDescription As Long '0x18, Pointer to Project Description szProjectHelpFile As Long '0x1C, Pointer to Project Help File dwReserved2 As Long '0x20, Always set to -1 after compiling. Unused dwHelpContextId As Long '0x24, Help Context ID set in Project Settings. End Type Private Type ObjectTable lpHeapLink As Long '0x00, Unused after compilation, always 0. lpExecProj As Long '0x04, Pointer to VB Project Exec COM Object. lpProjectInfo2 As Long '0x08, Secondary Project Information. dwReserved As Long '0x0C, Always set to -1 after compiling. Unused dwNull As Long '0x10, Not used in compiled mode. lpProjectObject As Long '0x14, Pointer to in-memory Project Data. uuidObject(15) As Byte '0x18, GUID of the Object Table. fCompileState As Integer '0x28, Internal flag used during compilation. dwTotalObjects As Integer '0x2A, Total objects present in Project. dwCompiledObjects As Integer '0x2C, Equal to above after compiling. dwObjectsInUse As Integer '0x2E, Usually equal to above after compile. lpObjectArray As Long '0x30, Pointer to Object Descriptors fIdeFlag As Long '0x34, Flag/Pointer used in IDE only. lpIdeData As Long '0x38, Flag/Pointer used in IDE only. lpIdeData2 As Long '0x3C, Flag/Pointer used in IDE only. lpszProjectName As Long '0x40, Pointer to Project Name. dwLcid As Long '0x44, LCID of Project. dwLcid2 As Long '0x48, Alternate LCID of Project. lpIdeData3 As Long '0x4C, Flag/Pointer used in IDE only. dwIdentifier As Long '0x50, Template Version of Structure. End Type Private Type PrivateObjectDescriptor lpHeapLink As Long '0x00, Unused after compilation, always 0. lpObjectInfo As Long '0x04, Pointer to the Object Info for this Object. dwReserved As Long '0x08, Always set to -1 after compiling. dwIdeData As Long '0x0C, [3] Not valid after compilation. Unknown1 As Long '0x10 Unknown2 As Long '0x14 lpObjectList As Long '0x18, Points to the Parent Structure (Array) dwIdeData2 As Long '0x1C, Not valid after compilation. lpObjectList2 As Long '0x20, [3] Points to the Parent Structure (Array). Unknown3 As Long '0x24 Unknown4 As Long ' 0x28 wIdeData3 As Long '0x2C, [3] Not valid after compilation. Unknown5 As Long '0x30 Unknown6 As Long '0x34 dwObjectType As Long '0x38, Type of the Object described. dwIdentifier As Long '0x3C, Template Version of Structure. End Type Private Type PublicObjectDescriptor lpObjectInfo As Long '0x00, Pointer to the Object Info for this Object. dwReserved As Long '0x04, Always set to -1 after compiling. lpPublicBytes As Long '0x08, Pointer to Public Variable Size integers. lpStaticBytes As Long '0x0C, Pointer to Static Variable Size integers. lpModulePublic As Long '0x10, Pointer to Public Variables in DATA section lpModuleStatic As Long '0x14, Pointer to Static Variables in DATA section lpszObjectName As Long '0x18, Name of the Object. dwMethodCount As Long '0x1C, Number of Methods in Object. lpMethodNames As Long '0x20, If present, pointer to Method names array. bStaticVars As Long '0x24, Offset to where to copy Static Variables. fObjectType As Long '0x28, Flags defining the Object Type. dwNull As Long '0x2C, Not valid after compilation. End Type Private Type ObjectInformation wRefCount As Integer '0x00, Always 1 after compilation. wObjectIndex As Integer '0x02, Index of this Object. lpObjectTable As Long '0x04, Pointer to the Object Table lpIdeData As Long '0x08, Zero after compilation. Used in IDE only. lpPrivateObject As Long '0x0C, Pointer to Private Object Descriptor. dwReserved As Long '0x10, Always -1 after compilation. dwNull As Long '0x14, Unused. lpObject As Long '0x18, Back-Pointer to Public Object Descriptor. lpProjectData As Long '0x1C, Pointer to in-memory Project Object. wMethodCount As Integer '0x20, Number of Methods wMethodCount2 As Integer '0x22, Zeroed out after compilation. IDE only. lpMethods As Long '0x24, Pointer to Array of Methods. wConstants As Integer '0x28, Number of Constants in Constant Pool. wMaxConstants As Integer '0x2A, Constants to allocate in Constant Pool. lpIdeData2 As Long '0x2C, Valid in IDE only. lpIdeData3 As Long '0x30, Valid in IDE only. lpConstants As Long '0x34, Pointer to Constants Pool. End Type Private Type OptionalObjectInformation dwObjectGuids As Long '0x00, How many GUIDs to Register. 2 = Designer lpObjectGuid As Long '0x04, Unique GUID of the Object *VERIFY* dwNull As Long '0x08, Unused. lpuuidObjectTypes As Long '0x0C, Pointer to Array of Object Interface GUIDs dwObjectTypeGuids As Long '0x10, How many GUIDs in the Array above. lpControls2 As Long '0x14, Usually the same as lpControls. dwNull2 As Long '0x18, Unused. lpObjectGuid2 As Long '0x1C, Pointer to Array of Object GUIDs. dwControlCount As Long '0x20, Number of Controls in array below. lpControls As Long '0x24, Pointer to Controls Array. wEventCount As Integer '0x28, Number of Events in Event Array. wPCodeCount As Integer '0x2A, Number of P-Codes used by this Object. bWInitializeEvent As Integer '0x2C, Offset to Initialize Event from Event Table. bWTerminateEvent As Integer '0x2E, Offset to Terminate Event in Event Table. lpEvents As Long '0x30, Pointer to Events Array. lpBasicClassObject As Long '0x34, Pointer to in-memory Class Objects. dwNull3 As Long '0x38, Unused. lpIdeData As Long '0x3C, Only valid in IDE. End Type Private Type ControlInformation fControlType As Long '0x00, Type of control. wEventCount As Integer '0x04, Number of Event Handlers supported. bWEventsOffset As Integer '0x06, Offset in to Memory struct to copy Events. lpGuid As Long '0x08, Pointer to GUID of this Control. dwIndex As Long '0x0C, Index ID of this Control. dwNull As Long '0x10, Unused. dwNull2 As Long '0x14, Unused. lpEventTable As Long '0x18, Pointer to Event Handler Table. lpIdeData As Long '0x1C, Valid in IDE only. lpszName As Long '0x20, Name of this Control. dwIndexCopy As Long '0x24, Secondary Index ID of this Control. End Type Private Function GetFakeHeader() As Long Dim lPtr As Long Dim lProc As Long Dim bData(1024) As Byte Dim sData As String Dim lRet As Long lPtr = App.hInstance Do While lRet = 0 Call ReadProcessMemory(-1, ByVal lPtr, bData(0), 1024, 0&) sData = StrConv(bData, vbUnicode) lRet = InStr(1, sData, "VB5!", vbBinaryCompare) lPtr = lPtr + 1024 Loop GetFakeHeader = lPtr + lRet - 1024 - 1 End Function Public Function GetFormAddress() As Long Dim dd As VBHeader Dim tt As ProjectInformation Dim ss As ObjectTable Dim aa As PublicObjectDescriptor Dim jj As OptionalObjectInformation Dim yy As ControlInformation Call ReadProcessMemory(-1, ByVal GetFakeHeader, dd, LenB(dd), 0) Call ReadProcessMemory(-1, ByVal dd.lpProjectData, tt, LenB(tt), 0) Call ReadProcessMemory(-1, ByVal tt.lpObjectTable, ss, LenB(ss), 0) Call ReadProcessMemory(-1, ByVal ss.lpObjectArray, aa, LenB(aa), 0) Call ReadProcessMemory(-1, ByVal aa.lpObjectInfo, jj, LenB(jj), 0) Call ReadProcessMemory(-1, ByVal jj.lpControls, yy, LenB(yy), 0) MsgBox jj.bWInitializeEvent MsgBox jj.bWTerminateEvent MsgBox yy.lpEventTable
|
|
|
18
|
Programación / Programación Visual Basic / Re: AddressOf Form_Initialize()
|
en: 1 Marzo 2011, 03:57 am
|
Gracias Leandro, pero no es eso lo que busco sino: Option Explicit
Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type
Public Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long Private Declare Function CreateThread Lib "kernel32" (ByVal lpSecurityAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long Private Declare Function VBDllGetClassObject Lib "MSVBVM60" (g1 As Long, g2 As Long, ByVal g3_vbHeader As Long, REFCLSID As Long, REFIID As GUID, ppv As Long) As Long Private Declare Function CreateIExprSrvObj Lib "MSVBVM60" (ByVal p1_0 As Long, ByVal p2_4 As Long, ByVal p3_0 As Long) As Long Private Declare Function CoInitialize Lib "OLE32" (ByVal pvReserved As Long) As Long Private Declare Sub CoUninitialize Lib "OLE32" () Private m_nFakeHeader As Long Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Sub CreateNewThread(ByVal lAddress As Long, ByVal lVal As Long, Optional ByRef lHandle As Long, Optional ByRef lThread As Long) If m_nFakeHeader = 0 Then Call GetFakeHeader
End If lHandle = CreateThread(ByVal 0&, ByVal 0&, lAddress, ByVal lVal, 0, lThread) End Sub
Public Sub InitCurrentThread() Call CreateIExprSrvObj(0, 4, 0) Call CoInitialize(0) Call InitVBdll End Sub
Public Sub TerminateCurrentThread() Call CoUninitialize End Sub
Public Sub GetFakeHeader() Dim lPtr As Long Dim lProc As Long Dim bdata(1024) As Byte Dim sData As String Dim lRet As Long lPtr = App.hInstance Do While lRet = 0 If Not ReadProcessMemory(-1, ByVal lPtr, bdata(0), 1024, 0&) = 0 Then sData = StrConv(bdata, vbUnicode) lRet = InStr(1, sData, "VB5!", vbBinaryCompare) Else Exit Sub End If lPtr = lPtr + 1024 Loop m_nFakeHeader = lPtr + lRet - 1024 - 1 End Sub
Private Sub InitVBdll() Dim pIID As GUID
With pIID .Data1 = 1 .Data4(0) = &HC0 .Data4(7) = &H46 End With 'Escribir en (AddressOf Main o AddressOf Form_Initialize): &HC3 (RETN) Call VBDllGetClassObject(0, 0, m_nFakeHeader, 0, pIID, 0) End Sub
Public Sub aaa() InitCurrentThread Form2.Show vbModal TerminateCurrentThread End Sub Si probas el código, podrás ver que al crear un thread nuevo se ejecuta la función principal del programa (Main o Form_Init..), yo creo poder evitar eso escribiendo un RETN &HC3, en la dirección de "la función principal" pero no se crear una función genérica que me devuelva la dirección sea un modulo o form. La función principal es llamada al llamar VBDllGetClassObject, estuve viendo las estructuras http://vb-decompiler.com/viewtopic.php?t=2 , pensando que podria encontrar la dirección ahi pero tampoco Bueno eso es lo que quiero hacer, pero necesito ayuda Saludos
|
|
|
|
|
|
|