this is a quick and dirty code to inject (and extract) a string into an png image. Feel free to use it in your applications.
Code: Select all
;this code is GPL
;codet by Neutrino
UsePNGImageDecoder()
UsePNGImageEncoder()
Declare ConvertCharToRGB(char.s)
Declare InjectStringToImage(FileName.s,StringToInject.s)
Declare.s ExtractStringFromImage(filename.s)
Declare CreateEmptyDataImage(filename.s)
Declare.s ConvertRGBToChar(rgbnumber)
If CreateEmptyDataImage("c:\test.png")
If InjectStringToImage("c:\test.png","hello word")
x$ = ExtractStringFromImage("c:\test.png")
;Debug x$
If x$
MessageRequester("Extracted String: ",x$,0)
Else
;error
MessageRequester("error","Extract String")
EndIf
Else
MessageRequester("error","Inject String")
EndIf
Else
MessageRequester("error","create image",0)
EndIf
Procedure ConvertCharToRGB(char.s)
Select char
Case "a" ;RGB(23,23,1)
ProcedureReturn 71447
Case "b" ;RGB(23,23,2)
ProcedureReturn 136983
Case "c" ;RGB(23,23,3)
ProcedureReturn 202519
Case "d" ;RGB(23,23,4)
ProcedureReturn 268055
Case "e" ;RGB(23,23,5)
ProcedureReturn 333591
Case "f" ;RGB(23,23,6)
ProcedureReturn 399127
Case "g" ;RGB(23,23,7)
ProcedureReturn 464663
Case "h" ;RGB(23,23,8)
ProcedureReturn 530199
Case "i" ;RGB(23,23,9)
ProcedureReturn 595735
Case "j" ;RGB(23,23,10)
ProcedureReturn 661271
Case "k" ;RGB(23,23,11)
ProcedureReturn 726807
Case "l" ;RGB(23,23,12)
ProcedureReturn 792343
Case "m" ;RGB(23,23,13)
ProcedureReturn 857879
Case "n" ;RGB(23,23,14)
ProcedureReturn 923415
Case "o" ;RGB(23,23,15)
ProcedureReturn 988951
Case "p" ;RGB(23,23,16)
ProcedureReturn 1054487
Case "q" ;RGB(23,23,17)
ProcedureReturn 1120023
Case "r" ;RGB(23,23,18)
ProcedureReturn 1185559
Case "s" ;RGB(23,23,19)
ProcedureReturn 1251095
Case "t" ;RGB(23,23,20)
ProcedureReturn 1316631
Case "u" ;RGB(23,23,21)
ProcedureReturn 1382167
Case "v" ;RGB(23,23,22)
ProcedureReturn 1447703
Case "w" ;RGB(23,23,23) / yeah goal
ProcedureReturn 1513239
Case "x" ;RGB(23,23,24)
ProcedureReturn 1578775
Case "y" ;RGB(23,23,25)
ProcedureReturn 1644311
Case "z" ;RGB(23,23,26)
ProcedureReturn 1709847
Case " " ;RGB(23,23,27)
ProcedureReturn 1775383
Case Chr(4);RGB(23,23,28) / end of string
ProcedureReturn 1840919
EndSelect
EndProcedure
Procedure.s ConvertRGBToChar(rgbnumber)
Select rgbnumber
Case 71447 ;RGB(23,23,1)
ProcedureReturn "a"
Case 136983 ;RGB(23,23,2)
ProcedureReturn "b"
Case 202519 ;RGB(23,23,3)
ProcedureReturn "c"
Case 268055 ;RGB(23,23,4)
ProcedureReturn "d"
Case 333591 ;RGB(23,23,5)
ProcedureReturn "e"
Case 399127 ;RGB(23,23,6)
ProcedureReturn "f"
Case 464663 ;RGB(23,23,7)
ProcedureReturn "g"
Case 530199 ;RGB(23,23,8)
ProcedureReturn "h"
Case 595735 ;RGB(23,23,9)
ProcedureReturn "i"
Case 661271 ;RGB(23,23,10)
ProcedureReturn "j"
Case 726807 ;RGB(23,23,11)
ProcedureReturn "k"
Case 792343 ;RGB(23,23,12)
ProcedureReturn "l"
Case 857879 ;RGB(23,23,13)
ProcedureReturn "m"
Case 923415 ;RGB(23,23,14)
ProcedureReturn "n"
Case 988951 ;RGB(23,23,15)
ProcedureReturn "o"
Case 1054487 ;RGB(23,23,16)
ProcedureReturn "p"
Case 1120023 ;RGB(23,23,17)
ProcedureReturn "q"
Case 1185559 ;RGB(23,23,18)
ProcedureReturn "r"
Case 1251095 ;RGB(23,23,19)
ProcedureReturn "s"
Case 1316631 ;RGB(23,23,20)
ProcedureReturn "t"
Case 1382167 ;RGB(23,23,21)
ProcedureReturn "u"
Case 1447703 ;RGB(23,23,22)
ProcedureReturn "v"
Case 1513239 ;RGB(23,23,23) / yeah goal
ProcedureReturn "w"
Case 1578775 ;RGB(23,23,24)
ProcedureReturn "x"
Case 1644311 ;RGB(23,23,25)
ProcedureReturn "y"
Case 1709847 ;RGB(23,23,26)
ProcedureReturn "z"
Case 1775383 ;RGB(23,23,27)
ProcedureReturn " "
Case 1840919;RGB(23,23,28) / end of string
ProcedureReturn Chr(4)
EndSelect
EndProcedure
Procedure CreateEmptyDataImage(filename.s)
If CreateImage(1,1025,1,32)
SaveImage(1,filename,#PB_ImagePlugin_PNG,10)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure InjectStringToImage(filename.s, StringToInject.s)
;all strings will automatic terminated with chr(4)
result = LoadImage(1,filename,0)
hdc = StartDrawing(ImageOutput(1))
If ImageHeight(1) Not 1 And ImageWidth(1) Not 1025
ProcedureReturn #False
EndIf
;Debug hdc
If result
If Len(StringToInject) > 1024
Debug "String is To long"
ProcedureReturn #False
Else
;success
;lets rock
For a = 1 To Len(StringToInject)
currentchar$ = Mid(StringToInject,a,1)
currentrgbvalue = ConvertCharToRGB(currentchar$)
;Debug "currentchar :" + currentchar$
;Debug "currentrgbvalue :" + Str(currentrgbvalue)
;SetPixel_(hdc,a,0,Val(Str(currentrgbvalue)))
SetPixel_(hdc,a,0,currentrgbvalue)
Next a
SetPixel_(hdc,a+1,0,ConvertCharToRGB(Chr(4)))
If SaveImage(1,filename,#PB_ImagePlugin_PNG,10)
Else
Debug "InjectStringToImage - Error saving"
EndIf
StopDrawing()
ProcedureReturn #True
EndIf
EndIf
EndProcedure
Procedure.s ExtractStringFromImage(filename.s)
result = LoadImage(1,filename,0)
If ImageHeight(1) Not 1 And ImageWidth(1) Not 1025
ProcedureReturn Str(#False)
EndIf
hdc = StartDrawing(ImageOutput(1))
If result
;success
For a = 1 To 1024
currentrgbvalue = GetPixel_(hdc,a,0)
;Debug currentrgbvalue
currentchar$ = ConvertRGBToChar(currentrgbvalue)
;Debug currentchar$
If currentchar$ = Chr(4)
Break
EndIf
string$ = string$ + currentchar$
Next a
ProcedureReturn string$
Else
;error
ProcedureReturn Str(#False)
EndIf
StopDrawing()
EndProcedure