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.
Cita de: Tughack en 16 Mayo 2008, 17:05 PM
Bueno depiende del uso. Yo creo k usar un Byte array es mas directo. Una string es Unicode... Voy intentar buscar algo k especifique alguna diferencia en el rendimento para darte una respuesta mas clara.
Saludos
Option Explicit
Private Sub Form_Load()
Dim StrImagen As String
Dim ArrImagen() As Byte
'----------------- cargar a un string
Open "C:\foto.bmp" For Binary As #1
StrImagen = Space(LOF(1))
Get #1, , StrImagen
Close #1
Debug.Print Len(StrImagen)
'----------------- cargar a un array
Open "C:\foto.bmp" For Binary As #1
ReDim ArrImagen(LOF(1))
Get #1, , ArrImagen
Close #1
Debug.Print UBound(ArrImagen)
End Sub
Cita de: SERBice en 16 Mayo 2008, 15:41 PM
yo tngo un splash en PNG que dice "Cargando" (elemental watson) y "..." (tres o cuatro puntos" que son "animados" por un timer para mostrarle al usuario que la App nose ha colgado cargando y un label que hace como photoshop (muestra "Cargando fuentes", es un ejemplo, mi app no carga fuentes.)
tengo la necesidad de mostrar controles o saber como insertar texto o imagenes sobre el form.
PD: ahhh.. si pudiera hacerce una aparicion con transparencia (digamos "fade-in" d form) seria excelente.
Option Explicit
Private Type LVITEM
mask As Long
iItem As Long
iSubitem As Long
state As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Const LVIF_IMAGE = &H2
Private Const LVIF_TEXT = &H1
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEM As Long = (LVM_FIRST + 5)
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEMSTATE = (LVM_FIRST + 44)
Private Const LVIS_SELECTED = &H2
Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43)
Private Const LVIF_STATE = &H8&
Private Const PAGE_READWRITE = &H4&
Private Const MEM_RESERVE = &H2000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private hWndlvw As Long
Function ListViewGetText(ByVal hwnd As Long, ByVal iSubitem As Integer, ByVal iItem As Integer) As String
Dim lngProcID As Long, lngProcHandle As Long
Dim typLvItem As LVITEM, strLvItem As String
Dim lngVarPtr1 As Long, lngVarPtr2 As Long
Dim lngMemVar1 As Long, lngMemVar2 As Long
Dim lngMemLen1 As Long, lngMemLen2 As Long
Call GetWindowThreadProcessId(hwnd, lngProcID)
If lngProcID <> 0 Then
lngProcHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lngProcID)
If lngProcHandle <> 0 Then
strLvItem = String(255, vbNullChar)
lngVarPtr1 = StrPtr(strLvItem)
lngVarPtr2 = VarPtr(typLvItem)
lngMemLen1 = LenB(strLvItem)
lngMemLen2 = LenB(typLvItem)
lngMemVar1 = VirtualAllocEx(lngProcHandle, 0, lngMemLen1, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
lngMemVar2 = VirtualAllocEx(lngProcHandle, 0, lngMemLen2, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
With typLvItem
.cchTextMax = 255
.iItem = iItem
.iSubitem = iSubitem
.mask = LVIF_TEXT
.pszText = lngMemVar1
End With
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar2, ByVal lngVarPtr2, lngMemLen2, 0)
Call SendMessage(hwnd, LVM_GETITEM, ByVal 0, ByVal lngMemVar2)
Call ReadProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
strLvItem = StrConv(strLvItem, vbUnicode)
strLvItem = Left(strLvItem, InStr(1, strLvItem, vbNullChar) - 1)
ListViewGetText = strLvItem
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar1, lngMemLen1, MEM_RELEASE)
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar2, lngMemLen2, MEM_RELEASE)
Call CloseHandle(lngProcHandle)
End If
End If
End Function
Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
hWndlvw = FindWindowEx(hwnd, 0&, "ListView20WndClass", "")
EnumWindowsProc = (hWndlvw = 0) 'Stop when we find first listview
End Function
' This demonstration example finds first child window with class "ListView20WndClass"
' which may not be what you want. Use your own method to find the real hWnd that you want
Public Function FindListView() As Long
EnumWindows AddressOf EnumWindowsProc, 0&
FindListView = hWndlvw
End Function
Public Function SelectedItem(ByVal hwnd As Long, ItemPos As Long)
Dim lProcID As Long
Dim hProc As Long
Dim lxprocLVITEM As Long
Dim LV_ITEM As LVITEM
GetWindowThreadProcessId hwnd, lProcID ' Get the process ID in which the ListView is running
If lProcID <> 0 Then
hProc = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lProcID) ' makwe sure we have read write permissions in the process space
If hProc <> 0 Then
lxprocLVITEM = VirtualAllocEx(hProc, 0, LenB(LV_ITEM), MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE) ' Grab enough memory in the other procedure's space to hold our LV_ITEM
' Set up our local LV_ITEM to change the selected item
LV_ITEM.mask = LVIF_STATE
LV_ITEM.state = True
LV_ITEM.stateMask = LVIS_SELECTED
' Copy the local LV_ITEM into the space we reserved in the foreign process
WriteProcessMemory hProc, ByVal lxprocLVITEM, ByVal VarPtr(LV_ITEM), LenB(LV_ITEM), 0
' Now send the message, but pass the address of the copy of our LV_ITEM that now exists in the foreign process instead of our local versiony
SendMessage hwnd, LVM_SETITEMSTATE, ItemPos, ByVal lxprocLVITEM
' Clean up
VirtualFreeEx hProc, ByVal lxprocLVITEM, LenB(LV_ITEM), MEM_RELEASE
CloseHandle hProc
End If
End If
End Function
Function GetListViewCount(ByVal hwnd As Long) As Long
'this simply get number of items
GetListViewCount = SendMessage(hwnd, LVM_GETITEMCOUNT, 0, ByVal 0)
End Function
Function GetItemSelected(hwnd As Long) As Long
Dim i As Long, Index As Long
For i = 1 To GetListViewCount(hwnd)
Index = SendMessage(hwnd, LVM_GETITEMSTATE, i - 1, ByVal LVIS_SELECTED)
If Index > 0 Then
GetItemSelected = i
Exit For
End If
Next
End Function
Dim Handle As Long
Dim Index As Long
Private Sub Command1_Click()
Index = InputBox("Selectiona el index")
SelectedItem Handle, Index
End Sub
Private Sub Command2_Click()
Index = InputBox("Selectiona el index del cual quieres ver")
MsgBox ListViewGetText(Handle, 0, Index)
End Sub
Private Sub Command3_Click()
MsgBox "el listview tiene " & GetListViewCount(Handle) & " Items"
End Sub
Private Sub Command4_Click()
MsgBox "El item selecionado es el " & GetItemSelected(Handle)
End Sub
Private Sub Form_Load()
ListView1.View = lvwList
ListView1.HideSelection = False
ListView1.ListItems.Add , , "hola"
ListView1.ListItems.Add , , "Mansana"
ListView1.ListItems.Add , , "Sapallo"
ListView1.ListItems.Add , , "terotero"
Handle = ListView1.hwnd
End Sub
Cita de: TughackOption Explicit
Dim SWs As New SHDocVw.ShellWindows
Dim IE As SHDocVw.InternetExplorer
Private Sub Command1_Click()
For Each IE In SWs
DoEvents
If IE.readyState = READYSTATE_COMPLETE Then
If IE.LocationURL = "http://www.elhacker.net/" Then
Text1.Text = IE.document.body.innerHTML
Exit For
End If
End If
Next IE
End Sub
buenisimo era eso, ahora que recuerdo Cobein en una vuelta me habia pasado algo parecido con SHDocVw.ShellWindows pero no savia como hacer el For Each IE In SWs, la verdad que me la iva a complicar mucho, lamentablemnte esto no va a servir obtener los script o para firefox u opera. pero bueno me safa.CitarPoned dudas mas concretas
' MaRi� G. Serrano. 16/Abril/2002.-
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteString Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Private Declare Function WriteValue Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Sub Command1_Click()
Dim str As String, MyString As String
MyString = "HELLO"
'in this case I read the memory of my own process
MsgBox "MyString= " & MyString
str = ReadMemory(Me.hWnd, StrPtr(MyString), LenB(MyString), "BYE!!")
MsgBox "Now, MyString=" & MyString & vbCr & "Old Value= " & str
End Sub
Private Function ReadMemory(hWnd As Long, Address As Long, Bytes As Long, Optional strReplaceWith As String) As String
'Runs For Not Unicode Strings (VB-Strings)
On Error Resume Next
Dim pId As Long ' Used to hold the Process Id
Dim pHandle As Long ' Holds the Process Handle
Dim bytValue As Long 'Stores the value of a byte in the memory
Dim i As Long
Dim Text As String
' Get the ProcId of the Window
GetWindowThreadProcessId hWnd, pId
' use the pId to get a handle
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pId)
If (pHandle = 0) Then
'MsgBox "Unable to open process!"
Exit Function
End If
If Address = 0 Then Exit Function
For i = 1 To Bytes Step 2
' Read Byte to Byte
ReadProcessMemory pHandle, Address + i - 1, bytValue, 1, 0&
'value now contains the long value of the byte located in [Address + i - 1] pos.
'ReadMemory is a string...
ReadMemory = ReadMemory & Chr$(bytValue)
Next
'to write numeric values you can ..(Must) use WriteValue API
If LenB(strReplaceWith) <> 0 Then
'No Unicode!!
WriteString pHandle, Address, StrPtr(strReplaceWith), LenB(strReplaceWith), 0&
End If
'Close the Handle
CloseHandle pHandle
End Function
Option Explicit
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Type MEMORY_BASIC_INFORMATION ' 28 bytes
BaseAddress As Long
AllocationBase As Long
AllocationProtect As Long
RegionSize As Long
State As Long
Protect As Long
lType As Long
End Type
Private Type SYSTEM_INFO ' 36 Bytes
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function VirtualQueryEx& Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Const GW_HWNDNEXT = 2
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Const PROCESS_VM_READ = (&H10)
Const PROCESS_VM_WRITE = (&H20)
Const PROCESS_VM_OPERATION = (&H8)
Const PROCESS_QUERY_INFORMATION = (&H400)
Const PROCESS_READ_WRITE_QUERY = PROCESS_VM_READ + PROCESS_VM_WRITE + PROCESS_VM_OPERATION + PROCESS_QUERY_INFORMATION
Const MEM_PRIVATE& = &H20000
Const MEM_COMMIT& = &H1000
Private Sub Command1_Click()
Dim pid As Long, hProcess As Long, hWin As Long
Dim lpMem As Long, ret As Long, lLenMBI As Long
Dim lWritten As Long, CalcAddress As Long, lPos As Long
Dim sBuffer As String
Dim sSearchString As String, sReplaceString As String
Dim si As SYSTEM_INFO
Dim mbi As MEMORY_BASIC_INFORMATION
sSearchString = Text2
sReplaceString = Text3 & Chr(0)
If IsWindowsNT Then 'NT store strings in RAM in UNICODE
sSearchString = StrConv(sSearchString, vbUnicode)
sReplaceString = StrConv(sReplaceString, vbUnicode)
End If
pid = Shell(Text1) 'launch application (calc.exe in this sample)
hWin = InstanceToWnd(pid) 'get handle of launched window - only to repaint it after changes
'Open process with required access
hProcess = OpenProcess(PROCESS_READ_WRITE_QUERY, False, pid)
lLenMBI = Len(mbi)
'Determine applications memory addresses range
Call GetSystemInfo(si)
lpMem = si.lpMinimumApplicationAddress
'Scan memory
Do While lpMem < si.lpMaximumApplicationAddress
mbi.RegionSize = 0
ret = VirtualQueryEx(hProcess, ByVal lpMem, mbi, lLenMBI)
If ret = lLenMBI Then
If ((mbi.lType = MEM_PRIVATE) And (mbi.State = MEM_COMMIT)) Then ' this block is In use by this process
If mbi.RegionSize > 0 Then
sBuffer = String(mbi.RegionSize, 0)
'Read region into string
ReadProcessMemory hProcess, ByVal mbi.BaseAddress, ByVal sBuffer, mbi.RegionSize, lWritten
'Check if region contain search string
lPos = InStr(1, sBuffer, sSearchString, vbTextCompare)
If lPos Then
CalcAddress = mbi.BaseAddress + lPos
Me.Show
ret = MsgBox("Search string was found at address " & CalcAddress & "." & vbCrLf & "Do you want to replace it?", vbInformation + vbYesNo, "VB-O-Matic")
If ret = vbYes Then
'Replace string in virtual memory
Call WriteProcessMemory(hProcess, ByVal CalcAddress - 1, ByVal sReplaceString, Len(sReplaceString), lWritten)
'Redraw window
InvalidateRect hWin, 0, 1
End If
Exit Do
End If
End If
End If
'Increase base address for next searching cicle. Last address may overhead max Long value (Windows use 2GB memory, which is near max long value), so add Error checking
On Error GoTo Finished
lpMem = mbi.BaseAddress + mbi.RegionSize
On Error GoTo 0
Else
Exit Do
End If
Loop
Finished:
CloseHandle hProcess
End Sub
Private Sub Form_Load()
Caption = "VB-O-Matic"
Label1 = "Start application:"
Label2 = "String to find:"
Label3 = "Replace with:"
Text1 = "Calc.exe"
Text2 = "Retroceso"
Text3 = "VB-O-Matic"
Command1.Caption = "&Launch It!"
End Sub
Private Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long
Dim test_pid As Long
Dim test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0
If GetParent(test_hwnd) = 0 Then
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Private Function IsWindowsNT() As Boolean
Dim verinfo As OSVERSIONINFO
verinfo.dwOSVersionInfoSize = Len(verinfo)
If (GetVersionEx(verinfo)) = 0 Then Exit Function
If verinfo.dwPlatformId = 2 Then IsWindowsNT = True
End Function
Cita de: jackl007 ツ en 1 Mayo 2008, 18:05 PM
Y has probado crear una matriz en el cliente y en el server, de modo que cada server[a] este conectado a cada cliente[a]; y asi seria como usar varios winsocks, pero teniendo uno solo.