temperaturas

[foreneo]

alguien que sepa como saber la temperatura del disco duro, el procesador y la tarjeta de video desde visual, y, se puede encriptar una base de datos para que nadie la habra cuando instales tu aplicacion y que el programa a un lea los datos de la base de datos?

[jc_moty]

Lo de la temperatura de los componentes no creo que lo podas hacer con VB; quiza con alguna API se pueda, pero realmente lo dudo.
Lo del encriptado; este codigo que voy a poner encripta cualquier tipo de archivo; haciendo uso del metodo RC4; personalmente me ha funcionado de maravilla, la logica del uso es que cuando cargas la aplicacion; tenes que desencriptar la BD; y cuando la cerras la volves a encriptar; como metodo alternativo de seguridad te recomiendo que le coloques una contraseña a tu BD, para que mientras la aplicacion esta abierta nadie pueda ver el contenido de esta.

El codigo:
En un modulo:

Código:

Option Explicit
Private i As Integer
Private j As Integer
Private k As Integer
Private a As Byte
Private b As Byte
Dim M As Integer
Private L As Long
Private RC4KEY(255) As Byte
Private ADDTABLE(255, 255) As Byte
Dim STATE(0 To 255) As Byte

Private Sub FILL_LINEAR()
    Dim bCONST(0 To 255) As Byte
    For M = 0 To 255
        bCONST(M) = M
        STATE(M) = bCONST(M)
    Next M
End Sub

Public Sub RC4(BYTEARRAY() As Byte, Optional PASSWORD As String)
  If PASSWORD <> "" Then PREPARE_KEY PASSWORD
  For L = 0 To UBound(BYTEARRAY)
    i = ADDTABLE(i, 1)
    j = ADDTABLE(j, STATE(i))
    a = STATE(i): STATE(i) = STATE(j): STATE(j) = a
    b = STATE(ADDTABLE(STATE(i), STATE(j)))
    BYTEARRAY(L) = BYTEARRAY(L) Xor b
  Next L
End Sub

Private Sub PREPARE_KEY(sKEY As String)
  INITIALIZE_ADDTABLE
  FILL_LINEAR
  k = Len(sKEY)
  For i = 0 To k - 1
    b = Asc(Mid$(sKEY, i + 1, 1))
    For j = i To 255 Step k
      RC4KEY(j) = b
    Next j
  Next i
  j = 0
  For i = 0 To 255
    k = ADDTABLE(STATE(i), RC4KEY(i))
    j = ADDTABLE(j, k)
    b = STATE(i): STATE(i) = STATE(j): STATE(j) = b
  Next i
  i = 0
  j = 0
End Sub
Private Sub INITIALIZE_ADDTABLE()
  Static BeenHereDoneThat As Boolean
  If BeenHereDoneThat Then Exit Sub
  For j = 0 To 255
    For i = 0 To 255
      ADDTABLE(i, j) = CByte((i + j) And 255)
    Next i
  Next j
  BeenHereDoneThat = True
End Sub

Public Function STRING_TO_BYTES(sString As String) As Byte()
  STRING_TO_BYTES = StrConv(sString, vbFromUnicode)
End Function

Public Function BYTES_TO_STRING(bBytes() As Byte) As String
  BYTES_TO_STRING = bBytes
  BYTES_TO_STRING = StrConv(BYTES_TO_STRING, vbUnicode)
End Function


' -- La funcion que hace todo --
Public Sub cryptFile(FileName As String)
  'Dim FileName As String
  Dim FileNum As Integer
  Dim FileBytes() As Byte

  'Reading File
  ReDim FileBytes(FileLen(FileName) - 1)
  FileNum = FreeFile
  Open FileName For Binary Access Read As FileNum
    Get #FileNum, , FileBytes
  Close FileNum

  'Encrypting/Decrypting Data
  RC4 FileBytes, "ClAvE" 'Password

  'Writing File
  FileNum = FreeFile
  Open FileName For Binary Access Write As FileNum
    Put #FileNum, , FileBytes
  Close FileNum
End Sub

Ejemplo de uso:

Código:

' AL CARGAR LA APLICACION
On Error GoTo errMgr
Dim Data As Connection
' Se establece la conexion a la BD
Set Data = New Connection
Data.ConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0; Data source = " & RUTA_BD & ";Persist Security Info=False;JET OLEDB:DATABASE PASSWORD=CONTRASEÑA"
Data.Open
errMgr:
    If Err.Number <> 0 Then
        Select Case Err.Number
            ' Por si la BD esta encriptada
            Case -2147467259
                cryptFile RUTA_DE_LA_BD
                Data.Open
            Case Else
                Msgbox Err.Description
        End Select
    End If

' Y AL CERRAR LA APLICACION
cryptFile RUTA_DE_LA_BD 

Ojo: Tene en cuenta que en este ejemplo hago uso de la referencia ActiveX Data Objects 2.x

Saludos

[foreneo]

no funciona tendre que buscar por otro lado