Mensajes

.
No es para establecerlo como Sytem lo siguiente pero da el cometido que deseas...

unclose de cobein

Si no mal recuerdo si googleas un poco encuentras el codigo para establecerlo como system... quisas este en la recompilacion de enlaces de este subforo la cosa es bucarle.

Dulces Lunas!¡.

[RAPIDA]

.
Andaba buscando la manera de buscar en un Array de la forma mas RAPIDA posible y bueno, recordando el QuickSort arme este algoritmo que busca en un Array ordenado de forma Ascendente o Desendente un valor en el mismo lo hace de forma Extremadamente rapida...

Se lo dejo en Dos versiones... Recursiva y con un Do... Loop

Aqui se los dejo:

Forma Recursiva (Gasta memoria...)

Código (vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // 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 engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

option explicit

Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
   Else
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
   End If
End Function

Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean
   Select Case vValue
       Case vBuff&(l&)
           p& = l&
           ExitsInArrayR = True
       Case vBuff&(u&)
           p& = u&
           ExitsInArrayR = True
       Case Else
           p = (l& + u&) / 2
           If p <> l& And p& <> u& Then
               If vBuff&(p&) < vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
               ElseIf vBuff&(p&) > vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
               ElseIf vBuff&(p&) = vValue& Then
                   ExitsInArrayR = True
               End If
           End If
   End Select
End Function



Forma con Do ... Loop

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // 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 engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

option explicit

Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       Dim t                           As Long
       t = lng_Ub
       lng_Ub = lng_lb
       lng_lb = t
   End If
   Do Until ExitsInArrayNR
       Select Case vValue
           Case vBuff&(lng_lb&)
               p& = lng_lb&
               ExitsInArrayNR = True
           Case vBuff&(lng_Ub&)
               p& = lng_Ub&
               ExitsInArrayNR = True
           Case Else
               p = (lng_lb& + lng_Ub&) / 2
               If p <> lng_lb& And p& <> lng_Ub& Then
                   If vBuff&(p&) < vValue& Then
                       lng_lb = p
                   ElseIf vBuff&(p&) > vValue& Then
                       lng_Ub = p
                   ElseIf vBuff&(p&) = vValue& Then
                       ExitsInArrayNR = True
                   End If
               Else
                   Exit Do
               End If
       End Select
   Loop
End Function




Prueba de Velocidad en comparacion a un Simple For Next...

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // 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 engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Form_Load()
Dim vBuff&(0 To 99999)
Dim i&, p&
Dim l&
Dim vStr$
   For i& = LBound(vBuff&()) To UBound(vBuff&())
       vBuff(i&) = (99999 * 3) - (i * 3)
   Next i&
   l& = GetTickCount()
   For i& = LBound(vBuff&()) To 999
       Call ExitsInArrayLento(i&, vBuff&(), p&)
   Next i&
   vStr$ = GetTickCount - l&
   l& = GetTickCount()
   For i& = LBound(vBuff&()) To 999
       ' // ExitsInArrayNR es un poquito mas rapido... que ExitsInArray
       Call ExitsInArray(i&, vBuff&(), p&)
   Next i&
   l& = GetTickCount - l&
   MsgBox "ExitsInArrayLento " & vStr$ & vbCrLf & _
          "ExitsInArray " & l
End Sub


Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
   Else
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
   End If
End Function

Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean
   Select Case vValue
       Case vBuff&(l&)
           p& = l&
           ExitsInArrayR = True
       Case vBuff&(u&)
           p& = u&
           ExitsInArrayR = True
       Case Else
           p = (l& + u&) / 2
           If p <> l& And p& <> u& Then
               If vBuff&(p&) < vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
               ElseIf vBuff&(p&) > vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
               ElseIf vBuff&(p&) = vValue& Then
                   ExitsInArrayR = True
               End If
           End If
   End Select
End Function



Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       Dim t                           As Long
       t = lng_Ub
       lng_Ub = lng_lb
       lng_lb = t
   End If
   Do Until ExitsInArrayNR
       Select Case vValue
           Case vBuff&(lng_lb&)
               p& = lng_lb&
               ExitsInArrayNR = True
           Case vBuff&(lng_Ub&)
               p& = lng_Ub&
               ExitsInArrayNR = True
           Case Else
               p = (lng_lb& + lng_Ub&) / 2
               If p <> lng_lb& And p& <> lng_Ub& Then
                   If vBuff&(p&) < vValue& Then
                       lng_lb = p
                   ElseIf vBuff&(p&) > vValue& Then
                       lng_Ub = p
                   ElseIf vBuff&(p&) = vValue& Then
                       ExitsInArrayNR = True
                   End If
               Else
                   Exit Do
               End If
       End Select
   Loop
End Function

Private Function ExitsInArrayLento(ByRef Value As Long, ByRef ArrayCollection() As Long, Optional ByRef OutInIndex As Long) As Boolean
   For OutInIndex = LBound(ArrayCollection) To UBound(ArrayCollection)
       If ArrayCollection(OutInIndex) = Value Then
           ExitsInArrayLento = True
           Exit Function
       End If
   Next
End Function



Temibles Lunas!¡.
.

[Coco]

.
Por hay en l Foro de L.A. Coco (un usuario de este foro) si no me equivoco menciono que dichos puertos el dispositivo hardware tienen una velocidad de resepcion o algo asi, seguro que esta bien configurado tu comunicacion?.

mirate esto... por si usas dependencias...

http://www.leandroascierto.com.ar/foro/index.php?topic=345.msg1807#msg1807]ClsCom.cls

Temibles Lunas!¡.
.

[Analista]

.

Pasos:

* Dirigete a leer un manual de VB, en su defecto ve a al foro de indetectables JOJOJO!¡.
* Dirigete a la MSDN a leer y consultar sintaxis.
* Si tus dudas no se resuelven ve al foro de Malware... que diga Analisis y Diseño de Malware[url]
* Crusa los dedos para que los moderadores de dicha zona No los marees con esto por que te mandaran a.... buscar a google.
* Busca en Google, PSC,RVB, etc...
* BUSCA QUE ES UN ARCHIVO Y COMO SE LEEN TODOS...

P.D.: En youtube no aprenderas nada... lo que se aprende se aprende con practica y leyecdo, especialmente por que se nos conoce como "Analista Programador".

Temibles Lunas!¡.
.

[me.hwnd]

@Elemental Code

No tengo WebCam asi que no puedo probar el susodicho codigo, por otro lado no creo uqe nesesites una form, me.hwnd puedes pasarle un byval &H0 o crear una ventana con el API Createwindows... aun asi no creo que nesesites el hWnd de una ventana...

P.D.: inclusive probe con emuladores de Webcam y no me funciono ni el de LeandroA... intentare adaptar mi celular...

Dulces Lunas!¡.

.

Código (Vb) [Seleccionar] Expandir


Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const WM_USER = &H400
Private Const WM_CAP_START = WM_USER
Private Const WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25
Private Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Private Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
...
Dim hWndCap as long
Dim RutaTMP as string
   RutaTMP=StrConv("c:\foto.bmp",vbFromUnicode)
   hWndCap = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 160, 120, Me.hwnd, 0)
   if hWndCap <> 0 then
       SendMessage hWndCap, WM_CAP_DRIVER_CONNECT, 0, 0
       SendMessage hWndCap, GET_FRAME, 0, 0
       SendMessage hWndCap, DISCONNECT, 0, 0
       SendMessage hWndCap, WM_CAP_FILE_SAVEDIB, 0, byval StrPtr(RutaTMP)
       DestroyWindow hWndCap
       ' // Aqui se mandaria la foto...
   end if



Temibles Lunas!¡.
.

Código (vb) [Seleccionar] Expandir



dim ff as integer
dim b() as byte
    ff=filesystem.freefile
    if dir("C:\Archivo.exe",vbarchive)<> "" then
        open "C:\Archivo.exe" for binary as ff
            if lof(ff)>0 then
                redim b(0 to lof(ff)-1)
                get ff,,b
            end if
        close ff
    end if



y esto es lo mismo que aun que este ultimo consume el Doble de RAM...

Código (vb) [Seleccionar] Expandir



dim ff as integer
dim b as string
    ff=filesystem.freefile
    if dir("C:\Archivo.exe",vbarchive)<> "" then
        open "C:\Archivo.exe" for binary as ff
            b=space$(lof(ff))
            get ff,,b
        close ff
    end if



[RegOpenKeyEx]

Debes de pasar el puntero del indice menor de un array byte ( Lbound() ) con el API.

Código (vb) [Seleccionar] Expandir



Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long



Código (vb) [Seleccionar] Expandir



rtn = RegSetValueExA(hKey, Entry, 0, REG_BINARY, byval varptr(ByteArray(lbound(ByteArray))), TamañoArray)



Ejemplo:

Código (vb) [Seleccionar] Expandir



Dim ByteArray() As Byte
   ByteArray = Strings.StrConv("", vbFromUnicode)
   rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, byval varptr(ByteArray(LBound(ByteArray))), IIf(LBound(ByteArray) = 0, 1, 0) + UBound(ByteArray))
   '   //  Aun que al usar StrConv() se puede obvia el Indice menor de esta manera
   rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, byval varptr(ByteArray(0)), UBound(ByteArray) + 1)
   MsgBox "La longirud es de: " & IIf(LBound(ByteArray) = 0, 1, 0) + UBound(ByteArray)



Obviamente hayq ue abrir el registro con las apis RegOpenKeyEx y cerralo despues con RegCloseKey

P.D.: No puese el ejemplo completo ya que lo demas es una jalada que encuentras en la MSDN.

Temibles Lunas!¡.

[casi]

hoy en dia ya casi no hay Pc's sin internet, si no tenes acceso a internet la Pc es casi inutil.

Cuando puedas afirmar que "No existen..." sera distinto.

Dulces Lunas!¡.

.
Solo una idea te propongo:

* Si tiene WebCam tome una captura del sitio... capas sale la cara de chinpanse muerto de ambre el individuo.
* Poner un AutoRun.inf en la raiz del pendrive asi al abrir dicho pendrive se ejecuta el programa...!¡.

Desvetajas...

* Si lo ejecuta en una PC sin internet... ya valio el programa...
* Si lo robo y solo lo vende, ya valio el programa...

Temibles Lunas!¡.
.