⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sm2.bas

📁 星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带
💻 BAS
字号:
Attribute VB_Name = "Sm2"

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
        'main1.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
'main1.Caption = al
 send = False
 main1.Winsock2.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




  

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -