sartos.bas

星子行V2.0(源码)公开星子行V3.0以上版本,都是由星子行V1.0和星子行V2.0的核心结合而开发成的! 星子行V1.0是单反接正法,星子行V2.0是多反接法,星子行V3.0以上版本都是多反

Attribute VB_Name = "Sartos"

Option Explicit

''\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'对连续的二个二进制值进行比较
'______________________________________________________________

Dim al As Long

Public Sub one(da() As Byte, I As Long)

'压缩算法''____________________________________________________
'MsgBox UBound(da())
'MsgBox i

Dim e As Long  '记录数组指针
Dim a1 As Long '记录数组值重复的个数
Dim a2 As Long '记录第一个重复的序号
Dim su() As Byte '压缩后的数组
Dim a3 As Long    '记录压缩后的数组的指针

ReDim su(I)




Do While e < I

If (a1 = 255) Then


        su(a3) = da(e)
        su(a3 + 1) = a1
        'main.Caption = a3
        a3 = a3 + 2
        a1 = 0
        
       If (e = I - 1) Then
         
          su(a3) = da(I)
          su(a3 + 1) = 0
      ReDim Preserve su(a3 + 5)
      End If
         
      
Else



     If da(e) = da(e + 1) Then
     
      a1 = a1 + 1
      
         If (e = I - 1) Then
         
            su(a3) = da(e)
            su(a3 + 1) = a1
          
          ReDim Preserve su(a3 + 5)

          
          End If
        

     Else
     
        

        su(a3) = da(e)
        su(a3 + 1) = a1
        
        a3 = a3 + 2
        a1 = 0
        
         If (e = I - 1) Then
         
          su(a3) = da(I)
          su(a3 + 1) = 0
      ReDim Preserve su(a3 + 5)

          
          End If


     End If
 
End If

e = e + 1

Loop




'MsgBox UBound(su())


If (send = True) Then
al = al + 1
'main.Caption = al
 send = False
 Main.Scmnet5.SendData su

 End If

''
''还原算法________________________________________________________


'Dim msu() As Byte '还原后要放入的数组
'Dim mi As Long    '记录还原时读出的指针
'Dim mx As Long    '重复的个数的递增
'Dim ma As Long    '记录写入的指针
'mi = 0
'mx = 0
'ma = 0



'ReDim msu(i)

'Do While mi < a3 + 1

  'Do While mx <= su(mi + 1)
  
    '  msu(ma) = su(mi)
   '   mx = mx + 1
  '    ma = ma + 1
 '  Loop
      

  
'mx = 0
'mi = mi + 2

'Loop

'MsgBox UBound(msu())


'Open "C:\zip.bmp" For Binary As #1
 '
'Put #1, 1079, msu
'Close #1
    
End Sub