Public ww, wh, n, m, p, t, maxid, h1, h2, finito, limite
Public nomefile As String
Dim k(400)
Private Function decifra(infile As String) As Boolean
Dim numfile1 As Integer
Dim numfile2 As Integer
Dim outfile As String
Dim xpos As Long
Dim x As Byte
Dim t(3) As Byte
MousePointer = 11
xpos = 4
outfile = "c:\temp.jpg"
numfile1 = FreeFile
Open infile For Binary As numfile1
numfile2 = FreeFile
Get #numfile1, 1, t(0)
Get #numfile1, 2, t(1)
Get #numfile1, 3, t(2)
Get #numfile1, 4, t(3)
If (t(0) = 0 And t(1) = 128 And t(2) = 0 And t(3) = 128) Then
Open outfile For Binary As numfile2
Do While Not EOF(numfile1)
xpos = xpos + 1
Get #numfile1, xpos, x
Put #numfile2, xpos - 4, x + 128
Loop
Close numfile2
Close numfile1
Kill infile
FileCopy outfile, infile
Kill outfile
decifra = True
Else
decifra = False
End If
MousePointer = 0
End Function
Function critto(infile As String) As Boolean
Dim numfile1 As Integer
Dim numfile2 As Integer
Dim outfile As String
Dim xpos As Long
Dim x As Byte
Dim t(3) As Byte
MousePointer = 11
xpos = 4
outfile = "c:\temp.enc"
numfile1 = FreeFile
Open infile For Binary As numfile1
numfile2 = FreeFile
Open outfile For Binary As numfile2
Get #numfile1, 1, t(0)
Get #numfile1, 2, t(1)
Get #numfile1, 3, t(2)
Get #numfile1, 4, t(3)
If (t(0) = 0 And t(1) = 128 And t(2) = 0 And t(3) = 128) Then
critto = False
MousePointer = 0
Close numfile2
Close numfile1
Exit Function
Else
Put #numfile2, 1, 0
Put #numfile2, 2, 128
Put #numfile2, 3, 0
Put #numfile2, 4, 128
Do While Not EOF(numfile1)
xpos = xpos + 1
Get #numfile1, xpos - 4, x
Put #numfile2, xpos, x + 128
Loop
Close numfile2
Close numfile1
Kill infile
FileCopy outfile, infile
Kill outfile
critto = True
End If
MousePointer = 0
End Function
Function getfile() As String
cd.CancelError = True
On Error GoTo filerr
cd.FileName = ""
cd.Filter = "Immagini (*.bmp;*.jp*;*.gif)|*.bmp;*.jp*;*.gif"
cd.ShowOpen
getfile = cd.FileName
Exit Function
filerr:
getfile = ""
End Function
Private Sub Command1_Click()
nomefile = getfile()
If nomefile <> "" Then
If critto(nomefile) = False Then
MsgBox "errore - file gia cifrato"
End If
End If
End Sub
Private Sub Command3_Click()
nomefile = getfile()
If nomefile <> "" Then
If decifra(nomefile) = False Then
MsgBox "errore nella decifrazione"
End If
End If
End Sub
|
