Vb security

[Fenomeno85]

Ciao a tutti, mi stavo chiedendo una cosa ... siccome per la tesina di fine anno ho una parte di acquisizione dati, mi piacerebbe sapere:
io acquisisco da un pc, i dati che prendo e che elaboro li spedisco al mio pc dove risiede il db ... posso fare un collegamento criptato nell'invio dei dati?? e poi il server (mio pc) decripta automaticamente i dati??

~§~ Sempre E Solo Lei ~§~

[matpez]

Si certo, ma come li mandi i dati...tramite il winsock ?

[cionci]

Ho riaperto...scusate...

Ciao

[Fenomeno85]

Originariamente inviato da cionci
Ho riaperto...scusate...

Ciao

de nada ... grazie cionci :)

comunque penso che dovrei implementare sotto winsock ma non se so nada.

~§~ Sempre E Solo Lei ~§~

[VICIUS]

Uhm se non ho capito male quello che vuoi fare è piu o meno quello che fa ssh. Inviare dati tramite un canale criptato da un client a un server. So che ssh usa SSL per che dovrebbe essere presente anche su windows, su planet source code se non ricordo male c'era anche un esempio. Se non vuoi scervellarti con librerie strane e affini puoi sempre inventarti un algoritmo anche molto semplice. Se non ricordo male basta anche una semplicissima trasformazione lineare che potrebbe essere un buon collegamento con matematica.

ciao ;)

[Fenomeno85]

dove posso trovare qualche esempio o spiegazione su queste cose?

~§~ Sempre E Solo Lei ~§~

[matpez]

Non penso che tu debba passare dati della N.A.S.A. cmq in ogni modo potresti passarli tramite winsock delle stringhe criptate con una chiava conosciuta da te, poi il programma da te che legge i dati e mette nel database li riconverte ed il gioco è fatto.

Se hai problemi di winsock ti posso postare qlc esempio a riguardo sulla connessione diretta tra server e client :)

[cionci]

Sì...infatti credo che ti basti criptare con qualcosa tipo l'algoritmo RC2...

[Fenomeno85]

se hai qualche esempio grazie :)

~§~ Sempre E Solo Lei ~§~

[matpez]

Se ci sono dubbi chiedi! :D

[matpez]

Questo sono 2 funzioni che ti servono per codificare/decodificare


Private Const CRYPT_NEWKEYSET As Long = &H8
Private Const MS_DEF_PROV As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL As Long = 1
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const ALG_SID_RC4 As Long = 1
Private Const ALG_SID_MD5 As Long = 3
Private Const CALG_MD5 As Long = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC4 As Long = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)
Private Const ENCRYPT_ALGORITHM As Long = CALG_RC4

Private Declare Function CryptAcquireContext Lib "Advapi32.dll" Alias "CryptAcquireContextA" (phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "Advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
Private Declare Function CryptHashData Lib "Advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "Advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, phKey As Long) As Long
Private Declare Function CryptDestroyHash Lib "Advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptDestroyKey Lib "Advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function CryptEncrypt Lib "Advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "Advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
Private Declare Function CryptReleaseContext Lib "Advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long


Public Function EncryptAPI(ByVal sTesto As String, ByVal sChiave As String, Optional ByVal bUUEncoding As Boolean = False) As String

'Cripta il testo specificato con le API.
On Error Resume Next

Dim lHHash As Long
Dim lHkey As Long
Dim lHExchgKey As Long
Dim lHCryptprov As Long
Dim lCryptLength As Long
Dim lCryptBufLen As Long
Dim lngRet As Long
Dim sCryptBuffer As String
Dim sProvider As String


If sTesto = "" Then Exit Function
sProvider = MS_DEF_PROV & vbNullChar
lngRet = CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL, 0)
If lngRet = 0 Then
lngRet = CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)
End If
If lngRet Then
If CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash) Then
If CryptHashData(lHHash, sChiave, Len(sChiave), 0) Then
If CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey) Then
CryptDestroyHash (lHHash)
lHHash = 0
lCryptLength = Len(sTesto)
lCryptBufLen = lCryptLength * 2
sCryptBuffer = String$(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = sTesto
If CryptEncrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptLength, lCryptBufLen) Then
sCryptBuffer = Mid$(sCryptBuffer, 1, lCryptLength)
If bUUEncoding Then
sCryptBuffer = UUEncode(sCryptBuffer)
End If
EncryptAPI = sCryptBuffer
End If
End If
End If
End If
End If
If Err.LastDllError Then Err = Err.LastDllError
If lHkey Then Call CryptDestroyKey(lHkey)
If lHExchgKey Then CryptDestroyKey (lHExchgKey)
If lHHash Then CryptDestroyHash (lHHash)
If lHCryptprov Then Call CryptReleaseContext(lHCryptprov, 0)

End Function

Public Function DecryptAPI(ByVal sTesto As String, ByVal sChiave As String, Optional ByVal bUUDecode As Boolean = False) As String

'Decripta il testo specificato con le API.
On Error Resume Next

Dim lHExchgKey As Long
Dim lHCryptprov As Long
Dim lHHash As Long
Dim lHkey As Long
Dim lCryptBufLen As Long
Dim sProvider As String
Dim sCryptBuffer As String


If sTesto = "" Then Exit Function
If bUUDecode Then
sTesto = UUDecode(sTesto)
End If
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL, 0) Then
If CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash) Then
If CryptHashData(lHHash, sChiave, Len(sChiave), 0) Then
If CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey) Then
CryptDestroyHash (lHHash)
lHHash = 0
lCryptBufLen = Len(sTesto) * 2
sCryptBuffer = String$(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = sTesto
If CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen) Then
DecryptAPI = Mid$(sCryptBuffer, 1, lCryptBufLen / 2)
End If
End If
End If
End If
End If
If Err.LastDllError Then Err = Err.LastDllError
If (lHkey) Then Call CryptDestroyKey(lHkey)
If lHExchgKey Then CryptDestroyKey (lHExchgKey)
If lHHash Then CryptDestroyHash (lHHash)
If lHCryptprov Then Call CryptReleaseContext(lHCryptprov, 0)

End Function

Private Function UUEncode(ByVal InputBuffer As String) As String

On Error Resume Next

Dim bytChar() As Byte
Dim bytBuffer() As Byte
Dim intStrPos As Integer
Dim strOutBuffer As String
Dim nLen As Integer


nLen = Len(InputBuffer)
For intStrPos = 1 To nLen Step 3
bytBuffer = StrConv(Mid$(InputBuffer, intStrPos, 3), vbFromUnicode)
ReDim Preserve bytChar(IIf(UBound(bytBuffer) = 3, 3, UBound(bytBuffer) + 1))
If UBound(bytBuffer) < 3 Then ReDim Preserve bytBuffer(UBound(bytBuffer) + 1)
bytChar(0) = Int(bytBuffer(0) / 4)
bytChar(0) = IIf(bytChar(0), (bytChar(0) And 63) + 32, 96)
bytChar(1) = ((bytBuffer(0) * 16) And 48) Or (Int(bytBuffer(1) / 16) And 15)
bytChar(1) = IIf(bytChar(1), (bytChar(1) And 63) + 32, 96)
bytChar(2) = ((bytBuffer(1) * 4) And 60) Or (Int(bytBuffer(2) / 64) And 3)
bytChar(2) = IIf(bytChar(2), (bytChar(2) And 63) + 32, 96)
bytChar(3) = (bytBuffer(2) And 63)
bytChar(3) = IIf(bytChar(3), (bytChar(3) And 63) + 32, 96)
strOutBuffer = strOutBuffer & StrConv(bytChar, vbUnicode)
Next
UUEncode = strOutBuffer
Err.Clear

End Function

Private Function UUDecode(ByVal InputBuffer As String) As String

On Error Resume Next

Dim bytChar() As Byte
Dim intLen As Integer
Dim strOutBuffer As String
Dim intFill As Integer

intLen = 1
intFill = Len(InputBuffer) Mod 4
InputBuffer = InputBuffer & String$(intFill, "`")
Do While intLen <= Len(InputBuffer)
bytChar = StrConv(Mid$(InputBuffer, intLen, 4), vbFromUnicode)
ReDim Preserve bytChar(3)
strOutBuffer = strOutBuffer & Chr$(((((bytChar(0) - 32) And 63) * 4) Or Int(((bytChar(1) - 32) And 63) / 16)) And &HFF)
strOutBuffer = strOutBuffer & Chr$(((((bytChar(1) - 32) And 63) * 16) Or Int(((bytChar(2) - 32) And 63) / 4)) And &HFF)
strOutBuffer = strOutBuffer & Chr$(((((bytChar(2) - 32) And 63) * 64) Or ((bytChar(3) - 32) And 63)) And &HFF)
intLen = intLen + 4
Loop
Select Case intFill
Case 1
UUDecode = Left$(strOutBuffer, Len(strOutBuffer) - intFill)
Case 2
UUDecode = Left$(strOutBuffer, Len(strOutBuffer) - intFill)
Case 3
UUDecode = Left$(strOutBuffer, Len(strOutBuffer) - intFill - 1)
Case Else
UUDecode = strOutBuffer
End Select
Err.Clear

End Function

[Fenomeno85]

ottimo ... nel client, dove c'è la possibilità di mettere l'indi ip, come faccio a mettere il nome di un sito?
Spiego, se io mi appoggio al nome del mio sito (che è in remoto sul mio pc) ho l'indirizzo ip.

~§~ Sempre E Solo Lei ~§~

[matpez]

Intendi appoggiarti ad un DNS ?

Perchè se tu vuoi per esempio comvertire un URL in IP ci sono diverse funzioni che lo fanno!

Vuoi fare così tu?

[Fenomeno85]

Originariamente inviato da matpez
Intendi appoggiarti ad un DNS ?

Perchè se tu vuoi per esempio comvertire un URL in IP ci sono diverse funzioni che lo fanno!

Vuoi fare così tu?

si esatto

~§~ Sempre E Solo Lei ~§~

[matpez]

Se manca qlc dimmelo.... :P


Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1

Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type

Private Function SocketsInitialize() As Boolean

Dim WSAD As WSADATA
Dim x As Integer


x = WSAStartup(WS_VERSION_REQD, WSAD)

If x <> 0 Then
SocketsInitialize = False
Exit Function
End If

If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
SocketsInitialize = False
Exit Function
End If

If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
SocketsInitialize = False
Exit Function
End If

SocketsInitialize = True

End Function

Private Function SocketsCleanup() As Boolean

Call WSACleanup

End Function

Private Function HiByte(ByVal wParam As Integer) As Variant

HiByte = wParam \ &H100 And &HFF&

End Function

Private Function LoByte(ByVal wParam As Integer) As Variant

LoByte = wParam And &HFF&

End Function

Public Function GetIPFromHostName(ByVal sHostName As String) As String

'converte l'host name in IP address.

Dim ptrHosent As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String


If SocketsInitialize() Then
sAddress = Space$(4)

ptrHosent = gethostbyname(sHostName & vbNullChar)

If ptrHosent <> 0 Then

ptrAddress = ptrHosent + 12

RtlMoveMemory ptrAddress, ByVal ptrAddress, 4
RtlMoveMemory ptrIPAddress, ByVal ptrAddress, 4
RtlMoveMemory ByVal sAddress, ByVal ptrIPAddress, 4

GetIPFromHostName = Asc(sAddress) & "." & Asc(Mid$(sAddress, 2, 1)) & "." & Asc(Mid$(sAddress, 3, 1)) & "." & Asc(Mid$(sAddress, 4, 1))

SocketsCleanup

End If
End If

End Function

[Fenomeno85]

oggi pome la guardo grazie

~§~ Sempre E Solo Lei ~§~

[Fenomeno85]

incomincio a rompere un pò:
1) ma quanto devo inizializzare MAX_WSADescription e MAX_WSASYSStatus??
2) il nome del sito è il valore di sHostName perchè è la variabile che faccio passare.

~§~ Sempre E Solo Lei ~§~

[matpez]

1) scusa mi sono dimenticato di dartele:

Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128

2) si è il nome del sito senza http://


Cmq se metti tutto in un modulo è meglio, così vedi solo la funzioni public, quelle private nn compaiono :)

[Fenomeno85]

RtlMoveMemory che fa che mi continua a dire che non è dichiarata??

~§~ Sempre E Solo Lei ~§~

[matpez]

Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)


Ti chiedo scusa ma io ho una classe intera sul network e quando tolgo qlc funzione per darla in giro mi dimentico sempre qlc pezzetto!! :cry:

[Fenomeno85]

tranquillo non ci sono problemi ;)

poi mi hai detto di mettere sotto modulo ... (siccome a scuola ste cose non vengono dette) una volta creato il modulo e messo il codice privato che faccio??

ottimo funziona tutto bene!

~§~ Sempre E Solo Lei ~§~

[Fenomeno85]

nella crittografia dei dati, nella sChiave che ci devo passaere??

~§~ Sempre E Solo Lei ~§~

[matpez]

Originariamente inviato da Fenomeno85
tranquillo non ci sono problemi ;)

poi mi hai detto di mettere sotto modulo ... (siccome a scuola ste cose non vengono dette) una volta creato il modulo e messo il codice privato che faccio??

ottimo funziona tutto bene!

~§~ Sempre E Solo Lei ~§~

Fai così, metti in un modulo tutto quello che riguarda la parte code/decode e nell'altro tutto quello che riguarda il DNS.

Tutto il codice nn solo quello privato, la cosa belle è che appunto mettendolo in un modulo, dalle tue form vedi solo le funzioni public e nn vedi anche quelle private (che a te nn interessano) dato che servono solo alle funzioni public :)

[matpez]

Originariamente inviato da Fenomeno85
nella crittografia dei dati, nella sChiave che ci devo passaere??

~§~ Sempre E Solo Lei ~§~

Ci devi passare la chiave di codifica/decodifica, è una chiave che serve a creare appunto il testo cifrato, chi nn è in possesso di quella chiave nn potrà (o almeno sarà quasi impossibile) tornare al testo originale al 100%

UUEncode è una speciale codifica che se nn erro c'è sotto unix, io di solito nn la uso, sta a te se usarla o no! :p

PS: fino a stasera nn posso + risponderti :)

ciaoooooooo

[Fenomeno85]

ottimo funziona tutto ;) ... adesso mi metto a perfezionarlo ;)

~§~ Sempre E Solo Lei ~§~

[matpez]

Originariamente inviato da Fenomeno85
ottimo funziona tutto ;) ... adesso mi metto a perfezionarlo ;)

~§~ Sempre E Solo Lei ~§~


:D

[Fenomeno85]

voglio sapere una tua considerazione:
io ho una acquisizione dati e potrei utilizzare due metodi:
1- una volta acquisiti (da client) inserisco direttamente su db i dati
2- acquisisco i dati, li mando con una connessione al server e poi li inserisco

secondo te per una tesina qual'è meglio?? Io sarei + sulla seconda

~§~ Sempre E Solo Lei ~§~

[Fenomeno85]

scasami ma come faccio a controllare se sono riuscito a connettermi al server??

~§~ Sempre E Solo Lei ~§~

[matpez]

All'evento _Connect del winsock

[Fenomeno85]

e ma come faccio a vedere se esegue o meno quella parte??

~§~ Sempre E Solo Lei ~§~

[matpez]

Fai una cosa del genere :D


Private Sub wskClient_Connect()

MsgBox "CONNESSO!!"

End Sub