PureBasic

Code : Tout sélectionner

Ra55

Code : Tout sélectionner

82975353

Code : Tout sélectionner

100111100100001101001111001

Code : Tout sélectionner

474415171

Code : Tout sélectionner

82975353

Code : Tout sélectionner

4F21A79

Code : Tout sélectionner

5c9g9

Code : Tout sélectionner

67111117991111173210510832102971051163298101971173210111632106101321151171051153299111110116101110116321001013211211411110311497109109101114

Code : Tout sélectionner

; http://www.purebasic.fr/english/viewtopic.php?t=9617&highlight=convert+base
; Code de AlGonzales modifié en base 62 par KCC

#BASEMIN =  2 
#BINBASE =  2 
#OCTBASE =  8 
#HEXBASE = 16 
#TRENTESIXBASE = 36 
#SOIXANTEDEUXBASE = 62

Procedure.s Int2Base(Value.l, Base.l) 

 Protected Result.s 

 If (Base >= #BASEMIN) And (Base <= #SOIXANTEDEUXBASE)
 
  Protected  i.l 

  Repeat 
   i = (Value % Base) + 1 
   Value = (Value / Base) 
   Result = Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", i, 1) + Result 
  Until Value = 0 

 EndIf 

 ProcedureReturn Result 

EndProcedure 

Procedure.l Base2Int(Value.s, Base.l) 
 
 Protected Result.l 
 Result = 0 

 If (Base >= #BASEMIN) And (Base <= #SOIXANTEDEUXBASE) 

  Protected i.l, c.l 

  For i = 1 To Len(Value) 

   c = FindString("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", Mid(Value, i, 1), 1) 
   ; Return -1 If character is not supported by base 

   If c > Base 
    Result -1 
    Break 
   EndIf 

   Result = (Result * Base) + (c - 1) 

  Next i 

 EndIf 

 ProcedureReturn Result 

EndProcedure
    
Procedure.s ConvertEnASCII(PhraseACoder.s)

 PhraseASCII.s
  
 For i = 1 To Len(PhraseACoder)
  
  NombreASCII.l = Asc(Mid(PhraseACoder, i, 1))
  PhraseASCII + Str(NombreASCII)
  
 Next

 ProcedureReturn PhraseASCII

EndProcedure


i = Val(ConvertEnASCII("Ra55"))
 
Bin.s = Int2Base(i, #BINBASE)
Oct.s = Int2Base(i, #OCTBASE)
Dec.s = Str(i)
Hex.s = Int2Base(i, #HEXBASE)
B62.s = Int2Base(i, #SOIXANTEDEUXBASE)

Debug "Ascii = " + Str(i)
Debug "Bin or Base  2 = " + Bin 
Debug "Oct or Base  8 = " + Oct
Debug "Dec or Base 10 = " + Dec
Debug "Hex or Base 16 = " + Hex
Debug "Base 62 = " + B62
Debug ""
Debug ""
Debug "Bin or Base  2 = " + Str(Base2Int(Bin, #BINBASE))
Debug "Oct or Base  8 = " + Str(Base2Int(Oct, #OCTBASE))
Debug "Dec or Base 10 = " + Dec
Debug "Hex or Base 16 = " + Str(Base2Int(Hex, #HEXBASE))
Debug "Base 62 = " + Str(Base2Int(B62, #SOIXANTEDEUXBASE))

Code : Tout sélectionner

Declare getmem(ID)
Declare putmem(id,mem)
Declare encode(txt$,id)
Declare.s decode(id)
;       bitmap=LoadImage(#PB_Any,"base.bmp") ; charge une image
;	encode("",bitmap)				; encode un texte dans l'image
;   SaveImage(bitmap,"kcc.bmp")	; sauve l'image avec le texte encodé
;   FreeImage(bitmap)				; libere la memoire
   bitmap=LoadImage(#PB_Any,"kcc.bmp") ;charge une image
Debug decode(bitmap)				; decode le texte contenu dans l'image
FreeImage(bitmap)
;
;
;
;   le signe     ; /!\
;						
;   indique que cette partie du code n'est utile que si l'on desire garder les delimitations de l'exemple
;   a savoir un pixel en bas et un pixel de chaque cote pour conserver la bordure
;
;
Procedure encode(txt$,id)
	*buffer=getmem(id)
	pos=33*4						; /!\
	x=1								; /!\
	For a=1 To Len(txt$)+1
		If a<=Len(txt$)
			PokeB(*buffer+pos,Asc(Mid(txt$,a,1)))
		Else
			PokeB(*buffer+pos,Asc(Mid(txt$,a,0)))
		EndIf
		z=z+1
		If z<3
			pos=pos+1
		Else 
			pos=pos+2
			x=x+1					; /!\
			If x=31					; /!\
				x=1					; /!\
				pos=pos+8			; /!\
			EndIf					; /!\
			z=0
		EndIf
	Next
	putmem(id,*buffer)
	FreeMemory(*buffer)
EndProcedure
Procedure.s decode(id)
	*buffer=getmem(id)
	pos=33*4						; /!\
	x=1								; /!\
	Repeat
		v=PeekB(*buffer+pos)
		Debug v
		z=z+1
		If z<3
			pos=pos+1
		Else 
			pos=pos+2
			x=x+1					; /!\
			If x=31					; /!\
				x=1					; /!\
				pos=pos+8			; /!\
			EndIf					; /!\
			z=0
		EndIf	
		If v<>0
			st$=st$+Chr(v)
		EndIf
	Until v=0
	FreeMemory(*buffer)
	ProcedureReturn(st$)
EndProcedure
Procedure getmem(ID) ; copie une image dans la memoire pour y effectuer des operations avec peek et poke :) 
	ImageID=  ImageID(id)
	Hdc = CreateCompatibleDC_ ( GetDC_ ( ImageID ))
	If HDC
		bmi.BITMAPINFO
		bm.BITMAP
		GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
		bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
		bmi\bmiheader\biWidth = bm\bmWidth
		bmi\bmiheader\biHeight = bm\bmHeight
		bmi\bmiheader\biPlanes = 1
		bmi\bmiheader\biBitCount = 32
		bmi\bmiheader\biCompression = #BI_RGB
		HList = AllocateMemory (bm\bmWidth*bm\bmHeight*4)
		GetDIBits_ (hDC, ImageID ,0,bm\bmHeight,HList,bmi, #DIB_RGB_COLORS ) 	
		ProcedureReturn HList
	EndIf	
EndProcedure
Procedure putmem(id,mem) ;copie une zone memoire dans une image existante
	ImageID=  ImageID(id)
	Hdc = CreateCompatibleDC_ ( GetDC_ ( ImageID ))
	If HDC
		bmi.BITMAPINFO
		bm.BITMAP
		GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
		bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
		bmi\bmiheader\biWidth = bm\bmWidth
		bmi\bmiheader\biHeight = bm\bmHeight
		bmi\bmiheader\biPlanes = 1
		bmi\bmiheader\biBitCount = 32
		bmi\bmiheader\biCompression = #BI_RGB
		HList = AllocateMemory (bm\bmWidth*bm\bmHeight*4)
		SetDIBits_ (hDC, ImageID ,0,bm\bmHeight,mem,bmi, #DIB_RGB_COLORS ) 			
	EndIf
EndProcedure