Mensajes

Primero que nada el code que puse fue solamente una broma.
Segundo, si crees que es muy sospechoso desempacalo y miralo
Tercero no voy a discutir si es bueno malo o si sirve o no =), cada uno puede opinar lo que quiera.

JAJAJAJ bueno espero que se hayan divertido como yo! =)

Con respecto a la tecnica, si usan un poco la imaginacion puede ser bastante util para proteger en cierta medida los programas.

Bueno, estaba aburrido y se me ocurrio hacer este code, es para proteger las aplicaciones, no es infalible pero seguramente va a molestar bastante a un debugger.

Espero que les guste y aprendan algo del code =)

Descarga
http://www.uploadsourcecode.com.ar/d/I0LDiGZnKy25FwuwoMJm408wEN1SIkkT

Aca les dejo un snippet que muestra como obtener el espacio libre, total y disponible de una unidad y formatearlo.

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Declare Function SHGetDiskFreeSpace Lib "shell32" Alias "SHGetDiskFreeSpaceA" (ByVal pszVolume As String, pqwFreeCaller As Currency, pqwTot As Currency, pqwFree As Currency) As Long
Private Declare Function StrFormatByteSize64A Lib "SHLWAPI.DLL" (ByVal qdw As Currency, ByVal pszBuf As String, ByVal uiBufSize As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Private Sub Form_Load()
    Dim cFreeCaller As Currency
    Dim cTotal      As Currency
    Dim cFreeTotal  As Currency
    Dim cFormat     As Currency
    Dim sBuff       As String
       
    If Not SHGetDiskFreeSpace( _
       Environ$("HOMEDRIVE"), _
       cFreeCaller, _
       cTotal, _
       cFreeTotal) = 0 Then
   
        Debug.Print "Drive: " & Environ$("HOMEDRIVE")
        cFormat = cFreeTotal:   GoSub Format: Debug.Print "Total Free Space: " & sBuff
        cFormat = cFreeCaller:  GoSub Format: Debug.Print "Free Caller: " & sBuff
        cFormat = cTotal:       GoSub Format: Debug.Print "Total Space: " & sBuff

    End If
   
    Exit Sub
Format:
    sBuff = Space(32)
    StrFormatByteSize64A cFormat, sBuff, 32
    sBuff = Left(sBuff, lstrlen(sBuff))
    Return
End Sub


Ahora quedo mejor!

Mi observacion fue simplemente para ayudar, se supone que la idea es que todos aprendamos de todos, y es bueno que comenten y hagan criticas constructivas asi todos podemos mojorar los codes y aprender.

Proba haciendo el checksum de todo....

Código [Seleccionar] Expandir



Private Sub Form_Load()
    Dim sVal        As String
    Dim sCheck      As String
    Dim i           As Long
    Dim svData()    As Byte
    Dim sPacket     As String

    sVal = "25" '// Valor

    sVal =Chr$(&H39) & Chr$(&H38) &  Right$(String(5, "0") & sVal, 5) '// Formateado para tener un largo de 5 caracteres

    svData =StrConv(sVal, vbFromUnicode) '// Lo convertimos en un bytearray

    For i = 1 To 6
        svData(0) = svData(0) Xor svData(i) '// Checksum
    Next

    sCheck = Chr$(svData(0)) '// convertimos el valor del checksum en un caracter

'////////////////////////////////////////// Corregido
  sPacket = Chr$(&H39) & Chr$(&H38) & sVal & sCheck & vbCr & vbLf '// armamos el pedido

    Debug.Print sPacket
End Sub


como dije anteriormente nunca en mi vida use una balanza de esas ni tengo una para probar nada.

La estructura del paquete parece estar bien, lo unico que se me ocurre es que purebes con un paquete asi "98000000" & vbcr & vblF en donde el importe es 0 y el checksum 0 a ver si obtenes respuesta.

Sino, telefono y a comunicarse con el fabricante! otra no se me ocurre

From M$

SetSystemPowerState Function

[SetSystemPowerState is available for use in the operating systems listed in the Requirements section. It may be altered or unavailable in subsequent versions. Applications written for Windows Vista and later should use SetSuspendState instead.]

EDIT

Los flags estan al reves ahora los corrijo

El tema de los privilegios funciona solamente en Vista, con respecto a otros OS a mi no me dio problemas, estoy utilizando los manifest que deje como ejemplo y no tube ningun problema en XP SP2. 

No se de otras versiones pero si alguno lo puede probar seria interesante saberlo.