Создание dll для кодирования/декодирования xxe и uue

CompilerIf #PB_Compiler_Unicode
  CompilerError "Отключите поддержку юникода"
CompilerEndIf

Structure Buff
  Buff.a[0]
EndStructure

Structure Param
  Code.a[255]
  SymX.a
  SymB.a
EndStructure

Structure slen
  *p
  len.l
EndStructure

EnableExplicit

Global bin_Size=0

Procedure NextNewLine(*Str.Buff, Size, Pos) ; Поиск перехода на новую строку.
  Protected NewPos=0, i
  
  For i=Pos To Size
    If *Str\Buff[i]=#CR
      If *Str\Buff[i+1]=#LF
        NewPos=i
        Break
      EndIf
    EndIf
  Next i
  
  ProcedureReturn NewPos
EndProcedure

Procedure.i Coder(*Src.Buff, Size, Fname.s, *Param.Param) ; Кодирование данных.
  Static Result.s
  Protected.l i, n, sz, pt
  Protected t.a, *s.Buff
  
  Result=""
  
  If *Src And Size>0 And Fname
    
    n = Size-1
    Result=Space(((n + 1) / 45) * 63 + ((n + 1) % 45) * 4 / 3 + 280)
    *s=@Result
    pt = 0 : i=0
    sz = PokeS(*s, "begin 644 " + fname + #CRLF$)
    pt = pt + sz + 1
    sz = pt - 1
    
    While i <= n
      
      Select i % 3
        Case 0
          *s\Buff[pt] = *Param\Code[*src\Buff[i] / 4] : pt = pt + 1
          t = (*src\Buff[i] & 3) * 16
        Case 1
          *s\Buff[pt] = *Param\Code[t + *src\Buff[i] / 16] : pt = pt + 1
          t = (*src\Buff[i] & 15) * 4
        Case 2
          *s\Buff[pt] = *Param\Code[t + *src\Buff[i] / 64] : pt = pt + 1
          *s\Buff[pt] = *Param\Code[*src\Buff[i] & 63] : pt = pt + 1
          t = 0
      EndSelect
      
      If i % 45 = 44
        *s\Buff[sz] = *Param\SymX
        *s\Buff[pt] = #CR : pt+1
        *s\Buff[pt] = #LF : pt+2 : sz=pt-1
      EndIf
      
      i+1
    Wend
    
    If (n+1) % 3 <>0
      *s\Buff[pt] = *Param\Code[t] : pt+1
    EndIf
    
    t=(n % 45) + 1
    If t <> 45 
      *s\Buff[sz] = *Param\Code[t]
      *s\Buff[pt] = *Param\SymB : pt+1
      *s\Buff[pt] = #CR : pt+1
      *s\Buff[pt] = #LF : pt+1
    EndIf
    
    PokeS(*s+pt, "end") : sz = pt + 2
    
  EndIf
  
  ProcedureReturn @Result
EndProcedure


Procedure.i Decoder(*Src, *ResultSize.Long, *Param.Param) ; Декодирование данных.
  Static Dim dst.a(0)              ; Указатель на этот массив возвращается процедурой.
  Protected.l i, j, k,lStart, Len
  Protected.a bStrLen, h, x
  Protected s.s, *s.Buff
  Protected NewList t.slen()
  
  If *ResultSize 
    *ResultSize\l=0
  EndIf
  
  bin_Size=0
  
    If *Src
      *s=*Src
      Len=MemoryStringLength(*Src)-1
      
      If CompareMemoryString(*s, @"begin ", #PB_String_NoCase, 6)=#PB_String_Equal
                
        j=NextNewLine(*s, Len, 0)
       
        Repeat
          
          If j=0 : Break : EndIf
          j+2
          i=j
          If CompareMemoryString(*s+j, @"end", #PB_String_NoCase, 3)=#PB_String_Equal
            Break
          EndIf
          lStart+*Param\Code[*s\Buff[j]]
          
          j=NextNewLine(*s, Len, j)
          If j>i+2 And AddElement(t())
              t()\p=*s+i
            If j>0
              t()\len=j-i
            Else
              t()\len=Len-i
            EndIf
          EndIf
        ForEver
        
        
        ReDim dst(lStart+4)
        
        If *ResultSize 
          *ResultSize\l=lStart
        EndIf
        bin_Size=lStart
        
        j = 0: lStart = 0: x = 0
        
        ForEach t()
          *s=PeekI(@t()\p)
          bStrLen = *Param\Code[*s\Buff[0]]
          Len=t()\len
          i = 2
          k = 0
          
          While i<=Len And k <= bStrLen - 1
            h = *Param\Code[*s\Buff[i-1]]
            
            Select i & 3
              Case 0
                dst(lStart + k) =  x + h / 4
                x = (h & 3) * 64
                k = k + 1
              Case 1
                dst(lStart + k) = x + h
                x = 0
                k = k + 1
              Case 2
                x = h * 4
              Case 3
                dst(lStart + k) = x + h / 16
                x = (h & 15) * 16
                k = k + 1
            EndSelect
            
            i+1
            
          Wend
          
          lStart = lStart + bStrLen
          j = j + 1
          
        Next
        
      EndIf
    EndIf
    
  ProcedureReturn @dst()

EndProcedure


ProcedureDLL AttachProcess(Instance) ; Вызывается системной при загрузке DLL процессом.
  Protected i, x.a
  Global.Param xxe_code, xxe_decode, uue_code, uue_decode
  
  xxe_code\SymB='+'
  xxe_code\SymX='h'
  xxe_code\Code[0]='+'
  xxe_code\Code[1]='-'
  For i=2 To 63
    If i<=11
      x='0'+(i-2)
    ElseIf i<=37
      x='A'+(i-12)
    Else
      x='a'+(i-38)
    EndIf
    xxe_code\Code[i]=x
  Next i
  
  xxe_decode\SymB='+'
  xxe_decode\SymX='h'
  For i='+' To 'z'
    If i='+'
      x=0
    ElseIf i='-'
      x=1
    ElseIf i>='0' And i<='9'
      x=2+(i-'0')
    ElseIf i>='A' And i<='Z'
      x=12+(i-'A')
    ElseIf i>='a' And i<='z'
      x=38+(i-'a')
    Else
      x=0
    EndIf
    xxe_decode\Code[i]=x
  Next i
  
  uue_code\SymB='`'
  uue_code\SymX='M'
  uue_code\Code[0]='`'
  For i=1 To 63
    uue_code\Code[i]=' '+i
  Next i
  
  uue_decode\SymB='`'
  uue_decode\SymX='M'
  uue_decode\Code['`']=0
  For i='!' To '_'
    uue_decode\Code[i]=i-' '
  Next i
  
EndProcedure

ProcedureDLL.i bin2xxe(*Src, Size, Fname.s)
  ProcedureReturn Coder(*Src, Size, Fname, @xxe_code)
EndProcedure

ProcedureDLL.i bin2uue(*Src, Size, Fname.s)
  ProcedureReturn Coder(*Src, Size, Fname, @uue_code)
EndProcedure

ProcedureDLL.i xxe2bin(*Src, *ResultSize)
  ProcedureReturn Decoder(*Src, *ResultSize, @xxe_decode)
EndProcedure

ProcedureDLL.i uue2bin(*Src, *ResultSize)
  ProcedureReturn Decoder(*Src, *ResultSize, @uue_decode)
EndProcedure

ProcedureDLL BinLen()
  ProcedureReturn bin_Size
EndProcedure

ProcedureDLL DataToFile(File.s, *Point, Size)
  Protected Result
  
  If *Point And Size
    If CreateFile(0, File)
      WriteData(0, *Point, Size)
      CloseFile(0)
      Result=#True
    EndIf
  EndIf
  
  ProcedureReturn Result
EndProcedure