PureBasic Forums - English

Code: Select all

;***********************************
;* Author   : Kent Jofur
;* Name     : Insert Packed-Text
;* Arguments: %TEMPFILE %CURSOR
;***********************************
EnableExplicit

;- Declares
Declare BestPackAndInsert(Text$, line, file$)
Declare ErrWin(msg$)

#MAXPERLINE   = 12

Define *ptr, line, Text$, Win, w, h, i
If CountProgramParameters()<>2
  ErrWin("Usage: %TEMPFILE %CURSOR")
Else
  win = OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, 600, 400, "Enter Text", #PB_Window_SystemMenu)
  If Win=#NUL
    ErrWin("Failed to open window")
  EndIf
  w= WindowWidth(win)
  h= WindowHeight(win)
  EditorGadget(0, 0, 0, w, h-22)
  ButtonGadget(1, w/2-42, h-20, 42<<1, 18, "Process")
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        End
      Case #PB_Event_Gadget
        If EventGadget()=1 And EventType()=#PB_EventType_LeftClick
          Break
        EndIf
    EndSelect
  ForEver
  BestPackAndInsert(GetGadgetText(0), Val(StringField(ProgramParameter(1), 1, "x")), ProgramParameter(0))
  CloseWindow(win)
EndIf

Procedure BestPackAndInsert(Text$, line, file$)
  Protected *p1, *p2, l, i, j=-1, bestP=#MAXLONG, p, *p
  Protected fh, filetype, dtype, LineStarted, datasize, s.s
  l = Len(Text$)
  *p1 = @Text$
  *p2 = AllocateMemory(l*SizeOf(Character) + 2*SizeOf(Integer))
  If *p1=#NUL Or *p2= #NUL
    ErrWin("Failed to allocate memory")
  EndIf
  For i=0 To 9
    p=PackMemory(*p1, *p2, l*SizeOf(Character), i)
    If p=0: Continue: EndIf
    If p < bestP
      bestP = p
      j = i
    EndIf
  Next i
  If bestP=#MAXLONG: ProcedureReturn : EndIf
  p=PackMemory(*p1, *p2, l*SizeOf(Character), j)
  *p=ReAllocateMemory(*p2, p)
  ;-------------------------------------------------------
  datasize = MemorySize(*p)
  If datasize=0: ProcedureReturn: EndIf
  NewList Line$()
  fh = ReadFile(#PB_Any, file$)
  If fh
    filetype = ReadStringFormat(fh)
    While Eof(fh)=#False
      AddElement(Line$())
      Line$()=ReadString(fh)
    Wend
    CloseFile(fh)
  EndIf
  fh = CreateFile(#PB_Any, file$)
  If fh
    FileBuffersSize(fh, 12*1024)
    i=0
    ForEach Line$()
      i+1
      WriteStringN(fh, Line$())
      If i=line
        s="PackedText_"+FormatDate("%yyyy_%mm_%dd_%hh_%ii_%ss", Date())+"_p"+Str(j)
        WriteStringN(fh, "DataSection"+#CRLF$+"Size"+s+":")
        WriteStringN(fh, "Data.i "+Str(l*SizeOf(Character))+"; packed to "+Str(p)+" bytes.")
        WriteStringN(fh, "Start"+s+": ;PackLevel=" + Str(j)+ ", Packed to=" + StrD(100.0*p/(1.0+l*SizeOf(Character)),2)+"%")
        While datasize > 0
          If datasize >= SizeOf(Quad)
            If LineStarted=#False
              dtype=SizeOf(Quad)
              LineStarted + 1
              WriteString(fh, "Data.q $"+RSet(Hex(PeekQ(*p)), SizeOf(Quad)*2,"0"))
              *p+SizeOf(Quad): datasize-SizeOf(Quad)
            Else
              LineStarted + 1
              WriteString(fh, ", $"+RSet(Hex(PeekQ(*p)), SizeOf(Quad)*2,"0"))
              *p+SizeOf(Quad): datasize-SizeOf(Quad)
            EndIf
            If LineStarted >= #MAXPERLINE
              WriteStringN(fh, "")
              LineStarted=#False
            EndIf
          Else ; < Quad
            If dtype=SizeOf(Quad)
              WriteStringN(fh, "")
              LineStarted=#False
            EndIf
            If LineStarted=#False
              dtype=SizeOf(Ascii)
              LineStarted=#True
              WriteString(fh, "Data.a $"+RSet(Hex(PeekA(*p)), SizeOf(Ascii)*2,"0"))
              *p+SizeOf(Ascii): datasize-SizeOf(Ascii)
            Else
              WriteString(fh, ", $"+RSet(Hex(PeekA(*p)), SizeOf(Ascii)*2,"0"))
              *p+SizeOf(Ascii): datasize-SizeOf(Ascii)
            EndIf
            If LineStarted >= #MAXPERLINE
              WriteStringN(fh, "")
              LineStarted=#False
            EndIf
          EndIf
        Wend
        WriteStringN(fh, #CRLF$+"End"+s+":"+#CRLF$+"EndDataSection")
      EndIf
    Next
    CloseFile(fh)
  EndIf
EndProcedure

Procedure ErrWin(msg$)
  Protected win, timer
  win = OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, 200, 25, "Error", #PB_Window_SystemMenu)
  If win
    If LoadFont(0, "Segoe UI", 9)
      SetGadgetFont(#PB_Default, FontID(0))
    EndIf
    AddWindowTimer(win, 0, 20*1000)
    TextGadget(0, 2, 2, WindowWidth(win)-4, WindowHeight(win)-4, msg$, #PB_Text_Border )
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_Timer, #PB_Event_CloseWindow
          Break
      EndSelect
    ForEver
    CloseWindow(win)
  EndIf
  End
EndProcedure

Code: Select all

*mem = AllocateMemory(?SizePackedText_2012_08_28_19_14_27_p0)
len  = UnpackMemory(?StartPackedText_2012_08_28_19_14_27_p0, *mem)
If OpenConsole()
  Print(PeekS(*mem))
  Input()
EndIf

DataSection
  SizePackedText_2012_08_28_19_14_27_p0:
  Data.i 100; packed to 70 bytes.
  StartPackedText_2012_08_28_19_14_27_p0: ;PackLevel=0, Packed to=69.31%
  Data.q $073800000064434A, $D24720006A1106CD, $23E8CC8D0303E823, $0C6C47940C405C20, $AB8848D911B362B0, $3DC1C6918A23608D, $479863400A20981A, $AE22066CD86921DE
  Data.a $40, $E0, $00, $00, $00, $00
  EndPackedText_2012_08_28_19_14_27_p0:
EndDataSection

Code: Select all

EnableExplicit

Procedure.s XCrypt(Phrase.s, Password.s)
  Protected NewPhrase.s = ""
  Protected Buffer.s = ""
  Protected Char.i = 0
  Protected x.i = 0, PPos.i = 0
  
  For x.i = 1 To Len(Phrase.s)
    PPos.i = PPos.i + 1
    If PPos.i > Len(Password.s): PPos.i = 1: EndIf
    Char.i = Asc(Mid(Phrase.s, x.i, 1)) ! Asc(Mid(Password.s, PPos.i, 1))
    Buffer.s = Buffer.s + Chr(Char.i)
    If Len(Buffer.s) > 1500
      NewPhrase.s = NewPhrase.s + Buffer.s
      Buffer.s =  ""
    EndIf
  Next
  NewPhrase.s = NewPhrase.s + Buffer.s
  Buffer.s =  ""
  ProcedureReturn NewPhrase.s
EndProcedure

Define Password.s = "pydLypwovIEthisfichsanVej3osht"
Define Secret.s = "The quick brown fox jumped over the lazy dog."

Define Encrypted.s = XCrypt(Secret.s, Password.s)

Debug "Encrypted: " + Encrypted.s

Define Decrypted.s = XCrypt(Encrypted.s, Password.s)

Debug "Decrypted: " + Decrypted.s

Code: Select all

; PassToHex by em_uk (Self Encryption from Droopy lib)

ProcedureDLL.s SelfEncryptionA(text.s,en.l) ; Encrypt a String (text) if en=#True / Decrypt if en=#False
  k1=Len(text) 
  If k1>0 
    *p=@text 
    k2=PeekB(*p) & $FF 
    r=k1 ! k2 
    If r<>0 : PokeB(*p,r) : EndIf 
    For i=2 To Len(text) 
      *p+1 
      If en : k1=PeekB(*p-1) & $FF : Else : k1=k2 : EndIf 
      k2=PeekB(*p) 
      r=k1 ! k2 
      If r<>0 : PokeB(*p,r) : EndIf 
    Next 
  EndIf 
  ProcedureReturn text 
EndProcedure 

Procedure.s PassToHex(passworda$="data",enc=#True)
  If enc
    tbufa$=SelfEncryptionA(passworda$,#True)
    passworda$=tbufa$
    tlen=Len(passworda$) : loc = 0
    tbuf$="" : loc = 0 
    For n = 0 To tlen-1
      loc=@passworda$+n
      result$= RSet(Hex(PeekB(loc)),2,"0")
      tbuf$+result$      
    Next       
    SetClipboardText("key$="+#DQUOTE$+tbuf$+#DQUOTE$)
    ProcedureReturn tbuf$      
  Else
    tlen=Len(passworda$)
    tbuf$=""
    For n= 0 To tlen
      n=n+1
      loc=@passworda$+n
      bufa$=Mid(passworda$,n,2)
      result$=Chr(Val("$"+bufa$))
      tbuf$+result$    
    Next
    tbufa$=SelfEncryptionA(tbuf$,#False)    
    ProcedureReturn tbufa$    
  EndIf  
EndProcedure

key$="ALL THE GIRLS LOVE ME"
Debug PassToHex(key$,#True) ; encrypts the string

; the procedure pastes the result to the clipboard.
; End

key$="5418547420682D0D4A03511D4E6E226D3B7E5E1356"
MessageRequester("Oh hai",PassToHex(key$,#False)) ; decrypts the string

Code: Select all

Debug PeekS(?sec_1)
Debug PeekS(?sec_3)


DataSection
sec_1:
Data.s "a"

sec_2:
Data.s "o"

sec_3:
Data.s "e"

sec_4:
Data.s "u"

sec_5:
Data.s "i"

EndDataSection

Code: Select all

#LinePrefix = "Data.s "
#LinePrefix1 = #TAB$ + #LinePrefix + #DQUOTE$
#LinePrefix2 = #TAB$ + #LinePrefix + #DQUOTE$

#LineSuffix1 = #DQUOTE$ + #CR$
#LineSuffix2 = #DQUOTE$

#SafetyOffset1 = 35
#SafetyOffset2 = 37

Global.s	dbs1, dbs2





; Place only this proc in your executable code.
; Call it with the two data strings, and it returns the useable string.

Procedure.s RecoverString(s1.s, s2.s)	; short demo adds ascii values of strings.
	Protected.i x = 1
	Protected.s s
	
	While Mid(s1, x, 1)
		v1 = Asc(Mid(s1,x,1))
		v2 = Asc(Mid(s2,x,1))
		s + Chr(v1 + v2 - #SafetyOffset1 - #SafetyOffset2)			; Add the "no invisible character" offset.
		
		x+1
	Wend
	
	ProcedureReturn s
	
EndProcedure



; The following code is just for generating the obfuscated text.

Procedure.s ObfuscateString(s.s)
	Protected.i x = 1, v1, v2
	Protected.s s1, s2
	
	s1 = s2
	
	While Mid(s, x, 1) 
		v1 = Asc(Mid(s,x,1))
		v2 = v1/2
		v2 + Random(8)		; add a little randomness
		v1 - v2
		V1 + #SafetyOffset1	; Ensure only visible characters, and no double quotes
		V2 + #SafetyOffset2
		
		s1 + Chr(v1)
		s2 + Chr(v2)
		x+1
	Wend
	
	dbs1 = s1
	dbs2 = s2
	
	s1 = #LinePrefix1 + s1 + #LineSuffix1
	s2 = #LinePrefix2 + s2 + #LineSuffix2
	ProcedureReturn s1 + s2 + "		; " + #DQUOTE$ + s + #DQUOTE$
	
EndProcedure



; Shows possible flags of StringGadget in action...
If OpenWindow(0, 0, 0, 322, 205, "StringGadget Flags", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	StringGadget(0, 8,  10, 306, 20, "Normal StringGadget...")
	EditorGadget(1, 8,  35, 306, 150)
	
	Repeat : 
		Event = WaitWindowEvent()
		
		Select Event
					
			Case #PB_Event_Gadget
					Select EventGadget()
						Case 0
								OutputText.s = ObfuscateString(GetGadgetText(0))
								SetGadgetText(1, OutputText)
								Debug RecoverString(dbs1, dbs2)		; demo to see recovered string
					EndSelect
		EndSelect
	Until Event = #PB_Event_CloseWindow
EndIf

Code: Select all

	Data.s "TNQPOMLNRPSNPQTMOP"
	Data.s "U[XYZ\][WYV[YXU\ZY"		; "aaaaaaaaaaaaaaaaaa"

Code: Select all

Debug Chr(PeekB(?sec_1+8)+PeekB(?sec_1+4)*100)
Debug Chr(PeekB(?sec_1+16)+PeekB(?sec_1+12)*100)

DataSection
sec_1:
Data.i 97,01,11,01,01,01,17,01,05
EndDataSection