PC Professionell 1999 October

home *** CD-ROM | disk | FTP | other *** search

/ PC Professionell 1999 October / PCpro_1999_10.ISO / Tools / vbcrypt / DES.frm (.txt) next >

Wrap

Visual Basic Form | 1998-03-02 | 14.6 KB | 575 lines

VERSION 5.00 Object = "{07D7C6E4-AE76-11D0-9A6F-000100000000}#1.0#0"; "DES.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX" Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX" Begin VB.Form frmHaupt BorderStyle = 3 'Fester Dialog Caption = "VBCrypt 0.9" ClientHeight = 3060 ClientLeft = 1635 ClientTop = 1695 ClientWidth = 5505 Icon = "DES.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3060 ScaleWidth = 5505 ShowInTaskbar = 0 'False Begin VB.CheckBox chkProtokolldatei Caption = "&Protokolldatei erstellen" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 5 Top = 2400 Width = 2535 End Begin ComctlLib.ProgressBar barFortschritt Height = 315 Left = 120 TabIndex = 4 Top = 960 Visible = 0 'False Width = 5115 _ExtentX = 9022 _ExtentY = 556 _Version = 327680 Appearance = 1 MouseIcon = "DES.frx":0442 End Begin MSComDlg.CommonDialog CommonDialog1 Left = 4320 Top = 2520 _ExtentX = 847 _ExtentY = 847 _Version = 327680 CancelError = -1 'True End Begin VB.CommandButton cmdEntschl sseln Caption = "&Entschl sseln" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 675 Left = 3720 TabIndex = 2 Top = 1440 Width = 1515 End Begin VB.TextBox txtSchl ssel BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 2520 MaxLength = 8 TabIndex = 1 Top = 360 Width = 1575 End Begin DESLib.DES DES1 Left = 4680 Top = 2640 _Version = 65536 _ExtentX = 741 _ExtentY = 741 _StockProps = 0 End Begin VB.CommandButton cmdVerschl sseln Caption = "&Verschl sseln" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 675 Left = 120 TabIndex = 0 Top = 1440 Width = 1515 End Begin MSComDlg.CommonDialog CommonDialog2 Left = 4800 Top = 2520 _ExtentX = 847 _ExtentY = 847 _Version = 327680 CancelError = -1 'True End Begin VB.Label Label1 Caption = "DES-Schl ssel (8-Zeichen):" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 720 TabIndex = 3 Top = 360 Width = 1695 End Attribute VB_Name = "frmHaupt" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Option Base 0 'Alle Arrays beginnen bei 0!!! 'Cipher-Clock-Chaining-Verfahren: 'Verschl sselung: ' Neue Chiffre = Verschl sseln( Klartext XOR vorangehende Chiffre ) 'Entschl sselung: ' Klartext = vorangehende Chiffre XOR Entschl sseln( aktuell zu entschl sselnde Chiffre) 'Achtung! Die folgenden Funktionen operieren auf Byte-Arrays mit einer e von jeweils 8 Elementen. Das DES-Control arbeitet allerdings mit 'Streings. Daher sind einige umst ndliche Umwandlungen zwischen String und 'Byte-Array n tig. Weil der Quiellcode des Controls vorliegt, l t es sich 'aber nach Bedarf anpassen. 'Byte-Array per XOR mit anderem Byte-Array verkn Sub DoCBC(finew() As Byte, fiprev() As Byte) Dim i As Integer For i = 0 To 7 finew(i) = finew(i) Xor fiprev(i) Next i End Sub 'Entschl sseln Private Sub cmdEntschl sseln_Click() Dim fn1 As Integer Dim fn2 As Integer Dim fs As Long 'In verschl sselter Datei gespeicherte Dateil Dim l As Long Dim i As Integer Dim s As String Dim fi(7) As Byte Dim finew(7) As Byte Dim fiprev(7) As Byte 'Schl ssel g ltig? If Len(txtSchl ssel) <> 8 Then MsgBox "Bitte geben Sie einen Schl ssel mit genau 8 Zeichen ein!" Exit Sub End If 'Zu entschl sselnde Datei und Zieldateinamen erfragen On Error Resume Next Err = 0 CommonDialog1.DialogTitle = "Zu entschl sselnde Datei:" CommonDialog1.ShowOpen If Err Then Exit Sub 'Cancel? CommonDialog2.DialogTitle = "Entschl sselte Datei:" CommonDialog2.ShowSave If Err Then Exit Sub 'Cancel? 'Quelldatei ffnen fn1 = FreeFile Open CommonDialog1.filename For Binary Access Read As fn1 If Err Then MsgBox Error$ & ": " & CommonDialog1.filename Exit Sub End If 'Zioeldatei ffnen/erzeugen fn2 = FreeFile Open CommonDialog2.filename For Binary Access Write As fn2 If Err Then MsgBox Error$ & ": " & CommonDialog2.filename Close #fn1 Exit Sub End If 'Schl ssel an Control bergeben DES1.Key = txtSchl 'ersten Block mit abgespeicherter Dateil nge laden Get #fn1, , fi 'Verschl sselungsergebnis des vorangehenden Blocks zun chst = 0 ClearByteArray fiprev 'Chiffre entschl sseln StringToByte DES1.DecryptString(ByteToString(fi)), finew 'CBC-ausf hren (in diesem Fall eigentlich berfl ssig) DoCBC finew, fiprev 'vorangehenden Chiffre-Block f r weitre CBS s merken CopyByteArray fiprev, fi 'genaue L nge der Datei ermitteln 'Datei liegt als Long (4 Bytes) vor fs = finew(3) fs = fs * 256 fs = fs + finew(2) fs = fs * 256 fs = fs + finew(1) fs = fs * 256 fs = fs + finew(0) 'Die Bytes 4 bis 7 k nnten zur berpr fung der Dateig ltigkeit '(z.B. Magicnumber) verwendet werden. barFortschritt.Visible = True 'Fortschrittsanzeige dargtellen l = fs While l >= 8 Get #fn1, , fi 'n chsten Chiffre-Block laden 'Fortschrittsanzeige aktualisieren barFortschritt.Value = 100 - CInt((CSng(l) / CSng(fs)) * 100) If Err Then MsgBox Error$ & ": " & CommonDialog1.filename GoTo Exit_Entschl sseln End If 'Chiffre entschl sseln StringToByte DES1.DecryptString(ByteToString(fi)), finew 'CBC mit vorangehender Chiffre DoCBC finew, fiprev 'aktuelle Chiffre f r weitere CBC s merken CopyByteArray fiprev, fi 'Klartext speichern Put #fn2, , finew If Err Then MsgBox Error$ & ": " & CommonDialog2.filename GoTo Exit_Entschl sseln End If 'Dateil nge verringern l = l - 8 Wend If l Then 'Ist das noch brig? Get #fn1, , fi(i) ' letzten Chiffre-Block laden If Err Then MsgBox Error$ & ": " & CommonDialog1.filename GoTo Exit_Entschl sseln End If 'Chiffre entschl sseln StringToByte DES1.DecryptString(ByteToString(fi)), finew 'CBC mit vorangehender Chiffre DoCBC finew, fiprev 'Die letzten Bytes aus der Chiffre holen i = 0 While l Put #fn2, , finew(i) ' If Err Then MsgBox Error$ & ": " & CommonDialog2.filename GoTo Exit_Entschl sseln End If l = l - 1 'Dateil nge verringern i = i + 1 'Index in Klartext-Array erh Wend End If ' Verschl sselung in Protokolldatei eintragen If chkProtokolldatei.Value = 1 Then Dim DateiNr As Integer DateiNr = FreeFile Open "Des.log" For Append As DateiNr Print #DateiNr, Format(Now, "Short Date") Print #DateiNr, CommonDialog1.filename Print #DateiNr, "Entschl sselt" Close End If Exit_Entschl sseln: 'Ende (auch vorzeitiges) barFortschritt.Visible = False 'Fortschroittsanzeige weg! Close #fn1 'Dateien schlie Close #fn2 End Sub 'Verschl sseln Private Sub cmdVerschl sseln_Click() Dim fn1 As Integer Dim fn2 As Integer Dim fs As Long 'In verschl sselter Datei zu speichernde Dateil Dim l As Long Dim i As Integer Dim s As String Dim fi(7) As Byte Dim finew(7) As Byte Dim fiprev(7) As Byte If Len(txtSchl ssel.Text) <> 8 Then MsgBox "Bitte geben Sie einen Schl ssel mit genau 8 Zeichen ein!" Exit Sub End If 'Zu verschl sselnde Datei und Namen der verschl sselten Datei ermitteln On Error Resume Next Err = 0 CommonDialog1.DialogTitle = "Zu verschl sselnde Datei:" CommonDialog1.ShowOpen If Err Then Exit Sub CommonDialog2.DialogTitle = "Verschl sselte Datei:" CommonDialog2.ShowSave If Err Then Exit Sub 'Dateil nge holen fs = FileLen(CommonDialog1.filename) If Err Then MsgBox Error$ & ": " & CommonDialog1.filename Exit Sub End If 'Zu verschl sselnde Datei ffnen fn1 = FreeFile Open CommonDialog1.filename For Binary Access Read As fn1 If Err Then MsgBox Error$ & ": " & CommonDialog1.filename Exit Sub End If 'Zieldatei ffnen/erzeugen fn2 = FreeFile Open CommonDialog2.filename For Binary Access Write As fn2 If Err Then MsgBox Error$ & ": " & CommonDialog2.filename Close #fn1 Exit Sub End If 'Schl ssel an Control bergeben DES1.Key = txtSchl ssel.Text 'effektive Dateil nge in erstem, verschl sselten Block speichern l = fs fi(0) = l And 255 l = l \ 256 fi(1) = l And 255 l = l \ 256 fi(2) = l And 255 l = l \ 256 fi(3) = l And 255 'den rest des blocks mit zufallszahlen f fi(4) = Int(Rnd() * 256) fi(5) = Int(Rnd() * 256) fi(6) = Int(Rnd() * 256) fi(7) = Int(Rnd() * 256) cmdVerschl sseln.Enabled = False 'Verschl sselungsergebnis des vorangehenden Blocks (zun chst alles 0) ClearByteArray fiprev 'CBC ausf DoCBC fi, fiprev 'Verschl sseln StringToByte DES1.EncryptString(ByteToString(fi)), finew 'Chiffre f r weitere CBCs merken CopyByteArray fiprev, finew 'Block speichern Put #fn2, , finew If Err Then MsgBox Error$ & ": " & CommonDialog2.filename GoTo Exit_Verschl sseln End If 'Fortschrittsanzeige einblenden barFortschritt.Visible = True l = fs While l >= 8 'Schleife ber alle Bl Get #fn1, , fi 'Block mit Klartext holen barFortschritt.Value = 100 - CInt((CSng(l) / CSng(fs)) * 100) DoEvents If Err Then MsgBox Error$ & ": " & CommonDialog1.filename GoTo Exit_Verschl sseln End If 'CBC durchf DoCBC fi, fiprev 'Verschl sseln StringToByte DES1.EncryptString(ByteToString(fi)), finew 'Chiffre speichern Put #fn2, , finew If Err Then MsgBox Error$ & ": " & CommonDialog2.filename GoTo Exit_Verschl sseln End If 'Chiffre-Block f r weitere CBCs merken CopyByteArray fiprev, finew 'soeben verschl sselten Block von Dateil nge abziehen l = l - 8 Wend 'Bleiben noch ein paar Bytes brig? If l Then i = 0 'restliche Bytes enzeln einlesen While l Get #fn1, , fi(i) If Err Then MsgBox Error$ & ": " & CommonDialog1.filename GoTo Exit_Verschl sseln End If i = i + 1 l = l - 1 Wend 'den Rest des Block mit Zufallszahlen auff For i = i To 7 fi(i) = Int(Rnd() * 255) Next 'CBC mit vorangehender Chiffre ausf DoCBC fi, fiprev 'Verschl sseln StringToByte DES1.EncryptString(ByteToString(fi)), finew 'Chiffre Speichern Put #fn2, , finew If Err Then MsgBox Error$ & ": " & CommonDialog2.filename GoTo Exit_Verschl sseln End If End If ' Verschl sselung in Protokolldatei eintragen If chkProtokolldatei.Value = 1 Then Dim DateiNr As Integer DateiNr = FreeFile Open "Des.log" For Append As DateiNr Print #DateiNr, Format(Now, "Long Date") Print #DateiNr, CommonDialog1.filename Print #DateiNr, "Verschl sselt mit Schl ssel: "; txtSchl ssel.Text Close End If Exit_Verschl sseln: barFortschritt.Visible = False Close #fn1 Close #fn2 cmdVerschl sseln.Enabled = True End Sub 'Byte-Array ion einen String aus 8 Zeichen wandeln Function ByteToString(b() As Byte) As String Dim s As String Dim i As Integer For i = 0 To 7 s = s & Chr$(b(i)) Next ByteToString = s End Function 'String (8-Zeichen) in eine Byte-Array wandeln Sub StringToByte(s As String, ByRef b() As Byte) Dim i As Integer For i = 0 To 7 b(i) = Asc(Mid$(s, i + 1, 1)) Next End Sub 'Byte-Array elementweise in anderes kopieren Sub CopyByteArray(ByRef bdst() As Byte, ByRef bsrc() As Byte) bdst(0) = bsrc(0) bdst(1) = bsrc(1) bdst(2) = bsrc(2) bdst(3) = bsrc(3) bdst(4) = bsrc(4) bdst(5) = bsrc(5) bdst(6) = bsrc(6) bdst(7) = bsrc(7) End Sub 'Elemente eines Byte-Arrays l schen Sub ClearByteArray(ByRef bdst() As Byte) bdst(0) = 0 bdst(1) = 0 bdst(2) = 0 bdst(3) = 0 bdst(4) = 0 bdst(5) = 0 bdst(6) = 0 bdst(7) = 0 End Sub