VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1380
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5025
   LinkTopic       =   "Form1"
   ScaleHeight     =   1380
   ScaleWidth      =   5025
   StartUpPosition =   2  'Bildschirmmitte
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   180
      TabIndex        =   1
      Top             =   720
      Width           =   4575
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   180
      TabIndex        =   0
      Top             =   300
      Width           =   4575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'ANMERKUNG: DEKOMPRIMIEREN GEHT NICHT
 
Private Sub Text1_Change()
'Text2.Text = Komprimieren(Text1.Text)
Text2.Text = Dekomprimieren(Text1.Text)
End Sub
 
Private Sub Text2_Change()
Me.Caption = Len(Text1.Text) & " - " & Len(Text2.Text)
End Sub
 
'a  000
'b  001
'c  010
'd  011
'e  100
'f  101
'g  110
'h  111
'aabbffeeehhbbccd  '15 Bytes; 45 Bits
'000 000 001 001 101 101 100 100 100 111 111 001 010 010 011
'--------------------
'00010 00110 10110 100110 11110 0010 01010 0110 '39 Bits
'Immer das Zeichen, anschließend eine 1 für jedes weitere Zeichen;
'bevor ein neues beginnt, eine 0
'--------------------
Function Komprimieren(ByVal C As String) As String
Dim I As Long, S As String, N As String, L As String
For I = 1 To Len(C)
    N = Asc(Mid(C, I, 1))
    N = DezToBinär(N)
    If Len(N) < 8 Then N = String(8 - Len(N), "0") & N
    If N = L Then
        S = S & "1"
    Else
        L = N
        If Len(S) > 0 Then
            S = S & "0" & N
        Else
            S = S & N
        End If
    End If
Next I
C = vbNullString
For I = 1 To Len(S) Step 8
    N = Mid(S, I, 8)
    N = BinärToDez(N)
    C = C & Chr(N)
Next I
Komprimieren = C
End Function
 
Function Dekomprimieren(ByVal C As String)
'd4™NbIÌè 2šMÂ9„ÜzΧ#Ñ”ä :NgI”ðt
Dim I As Long, S As String, N As String, L As String
For I = 1 To Len(C)
    N = Mid(C, I, 1)
    S = S & DezToBinär(Asc(N))
Next I
C = vbNullString
I = 0
Do
    'Schleife
    I = I + 1
    If I > Len(S) Then Exit Do
    'Inhalt
    N = Mid(S, I, 1)
    If Len(L) = 1 Then
        If N = "1" Then
            C = C & L
        ElseIf N = "0" Then
            L = ""
        End If
    Else
        N = Mid(S, I, 8)
        L = Chr(BinärToDez(N))
        I = I + 7                        '? (7, 8)
        C = C & L
    End If
Loop
Dekomprimieren = C
End Function

???????????????????????????????????????????????????????????
e7o.de | jetzt (wirklich) neu!