PureBasic Forums - English

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Read / Write Power Encoded String
; File Name : ReadWritePowerEncodedString.pb
; File version : 1.0.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 19-06-2010
; Mise à jour : 19-06-2010
; PureBasic cade : 4.50
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  
Procedure.q IntegerSquareRoot(Value.q)
  
  A.q = 0
  B.q = 6074000999
  Root.q = -1
  
  While A <= B
    
    D.q = (A + B) >> 1
    D1.q = D * D
    
    If Value > D1
      A = D + 1
    ElseIf Value < D1
      B = D - 1
    Else
      Root = D
      A = B + 1
    EndIf 
    
  Wend
  
  ProcedureReturn Root
EndProcedure 
  
Procedure.q IntegerCubicRoot(Value.q)
  
  A.q = 0
  B.q = 4194303
  Root.q = -1
  
  While A <= B
    
    D.q = (A + B) >> 1
    D1.q = D * D * D
    
    If Value > D1
      A = D + 1
    ElseIf Value < D1
      B = D - 1
    Else
      Root = D
      A = B + 1
    EndIf 
    
  Wend
  
  ProcedureReturn Root
EndProcedure 
  
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Écriture sur fichier binaire <<<<<
  
Procedure WritePowerEncodedString(FileID.l, String.s)
  
  StringLen.l = Len(String)
  *Source.CHARACTER = @String
  
  WriteLong(FileID, StringLen)
  
  For Index = 1 To StringLen
    
    Char01.c = PeekC(*Source)
    *Source + SizeOf(CHARACTER)
    
    If Index % 2 = 0
      WriteQuad(FileID, Char01 * Char01 * Char01)
    Else 
      WriteQuad(FileID, Char01 * Char01)
    EndIf 
    
  Next
  
EndProcedure 
   
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Lecture sur fichier binaire <<<<<
    
Procedure.s ReadPowerEncodedString(FileID.l)
  
  StringLen.l = ReadLong(FileID)
  String.s = Space(StringLen)
  *Source.CHARACTER = @String
  
  For Index = 1 To StringLen
    
    If Index % 2 = 0
      Char01.c = IntegerCubicRoot(ReadQuad(FileID))
    Else 
      Char01 = IntegerSquareRoot(ReadQuad(FileID))
    EndIf 
    
    PokeC(*Source, Char01)
    *Source + SizeOf(CHARACTER)
    
  Next
  
  ProcedureReturn String
EndProcedure 
  
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! WARNING - TESTING CODE !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  
Dim Texte.s(5)
  
Texte(0) = FormatDate("A=%yyyy, M= %mm, J=%dd - %hh:%ii:%ss", Date())
Texte(1) = "PureBasic 4.50 RC2"
Texte(2) = "FreeMat 4.0 (Similiaire à MatLab mais sans Simulink)"
Texte(3) = "Feel the Pure Power !"
Texte(4) = "PureBasic is the best programming language, period !"
Texte(5) = "Linux Ubuntu 10.04 LTS x86_64"
  
If CreateFile(0, "Test Power Encode.dat")
  
  For Index = 0 To 5
    WritePowerEncodedString(0, Texte(Index))
  Next
  
  CloseFile(0)
EndIf 
  
If ReadFile(1, "Test Power Encode.dat")
  
  For Index = 0 To 5
    Debug Texte(Index)
    Debug ReadPowerEncodedString(1)
    Debug ""
  Next
  
  CloseFile(1)
EndIf 
  
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Nom du projet : Read/Write Power Encoded String Memory
; Nom du fichier : Read Write Power Encoded String Memory.pb
; Version du fichier : 1.0.0
; Programmation : OK
; Programmé par : Guimauve
; Date : 25-06-2010
; Mise à jour : 25-06-2010
; Code PureBasic : 4.50
; Plateforme : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.q IntegerSquareRoot(Value.q)
  
  A.q = 0
  B.q = 6074000999
  Root.q = -1
  
  While A <= B
    
    D.q = (A + B) >> 1
    D1.q = D * D
    
    If Value > D1
      A = D + 1
    ElseIf Value < D1
      B = D - 1
    Else
      Root = D
      A = B + 1
    EndIf 
    
  Wend
  
  ProcedureReturn Root
EndProcedure 

Procedure.q IntegerCubicRoot(Value.q)
  
  A.q = 0
  B.q = 4194303
  Root.q = -1
  
  While A <= B
    
    D.q = (A + B) >> 1
    D1.q = D * D * D
    
    If Value > D1
      A = D + 1
    ElseIf Value < D1
      B = D - 1
    Else
      Root = D
      A = B + 1
    EndIf 
    
  Wend
  
  ProcedureReturn Root
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< WriteBinaryStringMemory <<<<<

Procedure.i WritePowerEncodedStringMemory(String.s)
  
  StringLen.l = Len(String)
  *Source.Character = @String
  
  *MemoryBuffer.i = AllocateMemory(SizeOf(Long) + StringLen * SizeOf(Quad))
  *PositionBuffer.i = *MemoryBuffer
  
  PokeL(*PositionBuffer, StringLen)
  *PositionBuffer + SizeOf(Long)
  
  For Index = 1 To StringLen
    
    Char01.c = PeekC(*Source)
    
    If Index % 2 = 0
      PokeQ(*PositionBuffer, Char01 * Char01 * Char01)
    Else 
      PokeQ(*PositionBuffer, Char01 * Char01)
    EndIf 
    
    *PositionBuffer + SizeOf(Quad)
    *Source + SizeOf(Character)
    
  Next
  
  ProcedureReturn *MemoryBuffer
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ReadBinaryStringMemory <<<<<

Procedure.s ReadPowerEncodedStringMemory(*MemoryBuffer.i)
  
  *PositionBuffer.i = *MemoryBuffer
  StringLen.l = PeekL(*PositionBuffer)
  *PositionBuffer + SizeOf(Long)
  String.s = Space(StringLen)
  *Source.Character = @String
  
  For Index = 1 To StringLen
    
    If Index % 2 = 0
      Char01.c = IntegerCubicRoot(PeekQ(*PositionBuffer))
    Else 
      Char01 = IntegerSquareRoot(PeekQ(*PositionBuffer))
    EndIf 
    
    PokeC(*Source, Char01)
    *PositionBuffer + SizeOf(Quad)
    *Source + SizeOf(Character)
    
  Next
  
  ProcedureReturn String
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! ATTENTION - CODE D'ESSAI !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Dim Texte.s(5)

Texte(0) = FormatDate("A=%yyyy, M= %mm, J=%dd - %hh:%ii:%ss", Date())
Texte(1) = "PureBasic 4.50"
Texte(2) = "FreeMat 4.0 (Similiaire à MatLab mais sans Simulink)"
Texte(3) = "Feel the pure power with PureBasic"
Texte(4) = "PureBasic is the best programming language, period !"
Texte(5) = "Linux Ubuntu 10.04 LTS x86_64"

Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Notez que dans l'exemple ci-dessous"
Debug "; les chaines de caractères proviennent"
Debug "; d'un tableau mais on pourrait utiliser"
Debug "; le nom du fichier que l'on va"
Debug "; compresser et que l'on peut récupérer"
Debug "; par la suite. Soit pour nommer le"
Debug "; fichier à la décompression, soit pour"
Debug "; identifier un fichier précis dans "
Debug "; l'archive."
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Textes originaux"
Debug ""

For Index = 0 To 5
  Debug Texte(Index)
Next

If CreatePack("Test Power Encoded.pak")
  
  For Index = 0 To 5
    MemBuffer.i = WritePowerEncodedStringMemory(Texte(Index))
    AddPackMemory(MemBuffer, MemorySize(MemBuffer), 9)
    FreeMemory(MemBuffer)
  Next
  
  ClosePack()
  
EndIf

Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Depuis la décompression"
Debug ""

If OpenPack("Test Power Encoded.pak")
  
  For Index = 0 To 5
    MemBuffer = NextPackFile()
    Debug ReadPowerEncodedStringMemory(MemBuffer)
  Next
  
  ClosePack()
  
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< FIN DU FICHIER <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<