PureBoard

Code: Alles auswählen

Procedure EncodeCCFile(infile.l, outfile.l, pw$, key$)
  ;/ des errechnen, schreiben
  ;/ mit base64 verschlüsselte strings reinschreiben
;-  decription
    UseFile(outfile)
    des$ = DESFingerprint(pw$, key$)
    WriteStringN(des$)
    Repeat
;-      math and text
        UseFile(infile)
        txt$ = ReadString()
        size = (Len(txt$) * 140) / 100
        Debug txt$
        If size > 0
;-        translating
          ;/ alle zeichen durchgehen und zum ASCII-Code des Zeichens den ASCII-Code des Passwortes
          ;/ hinzuaddieren, wenn Passwort zu kurz, mit Modulo umwandeln
          For c = 0 To Len(txt$)-1
            newchar = PeekB(@txt$ + c) + Asc(Mid(pw$, c % (Len(pw$)+1), 1))
            Debug Chr(newchar)
            PokeB(@txt$ + c, newchar)
          Next
;-        allocate
          *mem = AllocateMemory( size )
;-        encoding
          Base64Encoder(@txt$, Len(txt$), *mem, size)
        EndIf
;-      writing
        UseFile(outfile)
        WriteStringN(PeekS(*mem))
        If size > 0
          FreeMemory(*mem)
        EndIf
    Until Eof(infile)
    ProcedureReturn 1
EndProcedure

Procedure DecodeCCFile(infile.l, outfile.l, pw$, key$)
    UseFile(infile)
    des$ = ReadString()
    If DESFingerprint(pw$, key$) = des$
      Repeat
;-      math and read
        UseFile(infile)
        string$ = ReadString()
        size = (Len(string$) * 140) / 100
        Debug string$
        If size > 0
;-        allocate
          *mem = AllocateMemory( size )
;-        decoding
          Base64Decoder(@string$, Len(string$), *mem, size)
;-        translating
          txt$ = PeekS(*mem)
          For c = 0 To Len(txt$)-1
            newchar = PeekB(@txt$ + c) - Asc(Mid(pw$, c % (Len(pw$)+1), 1))
            PokeB(@txt$ + c, newchar)
          Next
        EndIf
;-      adding
        UseFile(outfile)
        WriteStringN(txt$)
        If size > 0
          FreeMemory(*mem)
        EndIf
      Until Eof(infile)
      ProcedureReturn 1
    Else
      ProcedureReturn 0
    EndIf
EndProcedure

;- 
;- SAMPLE
;- 

UsePNGImageDecoder()

IncludeFile "xp-button-constants.pbi"
IncludeFile "xp-button-includes.pbi"

Global c1,c2,c3,c4, bd, bp,bps, bu,bus, bd2, bp2,bps2, bu2,bus2

c1 = RGB(0,0,0)
c2 = RGB(0,0,0)
c3 = RGB(0,0,0)
c4 = RGB(128,128,128)

bd = UseImage(#xp_button_disabled)
bp = UseImage(#xp_button_pressed)
bps = UseImage(#xp_button_pressed_selected)
bu = UseImage(#xp_button_unpressed)
bus = UseImage(#xp_button_unpressed_selected)

bd2 = UseImage(#xp_button2_disabled)
bp2 = UseImage(#xp_button2_pressed)
bps2 = UseImage(#xp_button2_pressed_selected)
bu2 = UseImage(#xp_button2_unpressed)
bus2 = UseImage(#xp_button2_unpressed_selected)

;{ custom button
#CostumBotton_Toggle=1
#CostumBotton_CheckBox=2
#CostumBotton_Option=4

Global CButton_OptionOffset_
Structure CostumButton
  id.l
  hwnd.l
  text.s
  NormalTColor.l
  FocusTColor.l
  PressedTcolor.l
  DisabledTcolor.l
  normal.l
  focus.l
  pressed.l
  PFocus.l
  disabled.l
  State.l
  Type.l
  OptionOffset.l
EndStructure
NewList CButton_.CostumButton()
Procedure FreeCostumButton(id)
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        FreeGadget(id)
        CButton_()\text=""
        DeleteElement(CButton_())
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure FreeAllCostumButton()
  While FirstElement(CButton_())
    FreeCostumButton(CButton_()\id)
  Wend
EndProcedure

Procedure CostumButton(id,x,y,w,h,text.s,NormalTColor,FocusTColor,PressedTcolor,DisabledTcolor,FontId,normal,focus,pressed,PFocus,disabled,Type); for tcolor and fontid you can use -1 (#pb_default) for Systemdefaults
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        FreeCostumButton(id)
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
  AddElement(CButton_())
  CButton_()\id=id
  CButton_()\text=text
  CButton_()\NormalTColor=NormalTColor
  CButton_()\FocusTColor=FocusTColor
  CButton_()\PressedTcolor=PressedTcolor
  CButton_()\DisabledTcolor=DisabledTcolor
  CButton_()\normal  =normal
  CButton_()\focus   =focus
  CButton_()\pressed =pressed
  CButton_()\PFocus  =PFocus
  CButton_()\disabled=disabled
  CButton_()\Type    =Type
  CButton_()\OptionOffset=CButton_OptionOffset_
  CButton_()\hwnd=ButtonGadget(id,x,y,w,h,"",#BS_OWNERDRAW|$4000);bs_notify
  SetGadgetFont(id,FontId)
  ProcedureReturn CButton_()\hwnd
EndProcedure  
Procedure SetCostumButtonImage(id,normal,focus,pressed,PFocus,disabled) ; -1=no change!
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        If normal<>-1
          CButton_()\normal  = normal
        EndIf
        If pressed<>-1
          CButton_()\pressed = pressed
        EndIf
        If focus<>-1
          CButton_()\focus   = focus
        EndIf
        If PFocus<>-1
          CButton_()\PFocus  = PFocus
        EndIf
        If disabled<>-1
          CButton_()\disabled= disabled
        EndIf
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure SetCostumButtonText(id,text.s)
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        CButton_()\text=text
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure GetCostumButtonState(id)
  Result=0
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        Result=CButton_()\State
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
  ProcedureReturn Result
EndProcedure
Procedure SetCostumButtonState(id,State)
  If State: State=1 : EndIf
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        CButton_()\State=State
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure SetCostumButtonTextColor(id,NormalTColor,FocusTColor,PressedTcolor,DisabledTcolor); -1=Default: -2=nochange
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        If NormalTColor>-2
          CButton_()\NormalTColor=NormalTColor
        EndIf
        If FocusTColor>-2
          CButton_()\FocusTColor=FocusTColor
        EndIf
        If PressedTcolor>-2
          CButton_()\PressedTcolor=PressedTcolor
        EndIf
        If DisabledTcolor>-2
          CButton_()\DisabledTcolor=DisabledTcolor
        EndIf
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure ResizeCostumButton(id,x,y,w,h)
  If GetFocus_()=GadgetID(id)
    ok=#True
  EndIf
  HideGadget(id,#True)
  ResizeGadget(id,x,y,w,h)
  HideGadget(id,#False)
  If ok
    SetFocus_(GadgetID(id))
  EndIf
EndProcedure
Procedure StartCostumButtonOption()
  CButton_OptionOffset_+1
EndProcedure
;-
Procedure Callback(WindowID, message, wParam, lParam) 
  Result = #PB_ProcessPureBasicEvents 
  If message = #WM_COMMAND And wParam>>16&$FFFF=#BN_CLICKED
    ResetList(CButton_())
    ok=#False
    Repeat
      If NextElement(CButton_())
        If CButton_()\hwnd=lParam
          
          If CButton_()\Type&#CostumBotton_Option
            id          =CButton_()\id
            OptionOffset=CButton_()\OptionOffset
            CButton_()\State=1
            RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
            ResetList(CButton_())
            While NextElement(CButton_())
              If CButton_()\Type=#CostumBotton_Option And CButton_()\OptionOffset=OptionOffset And CButton_()\id<>id And CButton_()\State
                CButton_()\State=0
                RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
              EndIf
            Wend
          ElseIf CButton_()\Type&(#CostumBotton_Toggle|#CostumBotton_CheckBox)
            CButton_()\State=1-CButton_()\State
            RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
          EndIf
          ok=#True
        EndIf
      Else 
        ok=#True
      EndIf
    Until ok
  EndIf
      
  If message = #WM_DRAWITEM 
    *dis.DRAWITEMSTRUCT = lParam 
    If *dis\CtlType=#ODT_BUTTON	
      ResetList(CButton_())
      ok=#False
      Repeat
        If NextElement(CButton_())
          If CButton_()\hwnd=*dis\hwndItem
            pic=CButton_()\normal
            TColor=CButton_()\NormalTColor
            If *dis\itemState & #ODS_DISABLED
              ;{Disabled
              pic=CButton_()\disabled
              If CButton_()\DisabledTcolor>-1
                TColor=CButton_()\DisabledTcolor
              EndIf
              ;}
            ElseIf CButton_()\Type=#CostumBotton_Toggle
              ;{Toggle-Button
              State=CButton_()\State
              If *dis\itemState & #ODS_SELECTED: State=1-State : EndIf
              
              If State=0
                If *dis\itemState & #ODS_FOCUS
                  pic=CButton_()\focus
                  If CButton_()\FocusTColor>-1
                    TColor=CButton_()\FocusTColor
                  EndIf
                EndIf
              Else
                If *dis\itemState & #ODS_FOCUS
                  pic=CButton_()\PFocus
                  If CButton_()\FocusTColor>-1
                    TColor=CButton_()\FocusTColor
                  EndIf
                Else
                  pic=CButton_()\pressed
                  If CButton_()\FocusTColor>-1
                    TColor=CButton_()\FocusTColor
                  EndIf
                EndIf
              EndIf
              ;}
            ElseIf CButton_()\Type&(#CostumBotton_CheckBox|#CostumBotton_Option)
              ;{Checkbox
              If *dis\itemState & #ODS_FOCUS
                If CButton_()\FocusTColor>-1
                  TColor=CButton_()\FocusTColor
                EndIf
              EndIf
              State=CButton_()\State
              If State=0
                If *dis\itemState & #ODS_SELECTED
                  pic=CButton_()\focus
                EndIf
              Else
                If *dis\itemState & #ODS_SELECTED
                  pic=CButton_()\PFocus
                Else
                  pic=CButton_()\pressed
                EndIf
              EndIf
              ;}
            ElseIf *dis\itemState & #ODS_SELECTED 
              ;{normal
              pic=CButton_()\PFocus
              If CButton_()\PressedTcolor>-1
                TColor=CButton_()\PressedTcolor
              EndIf
            ElseIf *dis\itemState & #ODS_FOCUS 
              pic=CButton_()\focus
              If CButton_()\FocusTColor>-1
                TColor=CButton_()\FocusTColor
              EndIf
              ;}
            EndIf
            
            oldmode=SetBkMode_(*dis\hdc, #TRANSPARENT)
            
            point.POINT\x=0:point\y=0
            MapWindowPoints_(GetParent_(CButton_()\hwnd),CButton_()\hwnd,point,1)
            
            BackBrush=GetClassLong_(WindowID(), #GCL_HBRBACKGROUND)
            SetBrushOrgEx_(*dis\hdc,point\x,point\y,oldpoint.POINT)
            FillRect_(*dis\hdc,*dis\rcItem,BackBrush)
            SetBrushOrgEx_(*dis\hdc,oldpoint\x,oldpoint\y,0)
            
            GetObject_(pic,SizeOf(BITMAP),bmp.BITMAP)
            
            If pic
              imglist=ImageList_Create_(bmp\bmWidth,bmp\bmHeight,#ILC_COLORDDB|#ILC_MASK,1,0) 
              ImageList_AddMasked_(imglist,pic,0)
              ImageList_Draw_(imglist,0,*dis\hdc,*dis\rcItem\left,*dis\rcItem\top,#ILD_TRANSPARENT	) 
              ImageList_Destroy_(imglist) 
            EndIf
            
            
            GetTextExtentPoint32_(*dis\hdc,@CButton_()\text,Len(CButton_()\text),size.SIZE)
            
            h=((*dis\rcItem\bottom-*dis\rcItem\top      )-size\cy)/2
            
            If CButton_()\Type&( #CostumBotton_CheckBox|#CostumBotton_Option)
              w=bmp\bmWidth+2
              
              If *dis\itemState & #ODS_FOCUS
                hpen=CreatePen_(#PS_DOT,1,TColor)
                SelectObject_(*dis\hdc,hpen)
                x1=*dis\rcItem\left+w-1
                y1=*dis\rcItem\top+h-1
                x2=*dis\rcItem\left+w+size\cx+1
                y2=*dis\rcItem\top+h+size\cy+1 
                MoveToEx_(*dis\hdc,x1,y1,oldpoint.POINT)
                LineTo_(*dis\hdc,x2,y1)
                LineTo_(*dis\hdc,x2,y2)
                LineTo_(*dis\hdc,x1,y2)
                LineTo_(*dis\hdc,x1,y1)
                
                DeleteObject_(hpen)
              EndIf
              
              
            Else
              w=((*dis\rcItem\right -*dis\rcItem\left)-size\cx)/2
            EndIf 
            
            
             
            If TColor>-1
              SetTextColor_(*dis\hdc, TColor)
            EndIf
            
            ; If *dis\itemState & #ODS_SELECTED
              ; TextOut_(*dis\hdc,*dis\rcItem\left+w+1,*dis\rcItem\top+h+2,@CButton_()\text,Len(CButton_()\text))
            ; Else
              TextOut_(*dis\hdc,*dis\rcItem\left+w,*dis\rcItem\top+h,@CButton_()\text,Len(CButton_()\text))
            ; EndIf
            SetBkMode_(*dis\hdc,oldmode)
            
            
            Result=#True
            ok=#True
          EndIf
        Else
          ok=#True
        EndIf
      Until ok
    EndIf
  EndIf
  ProcedureReturn Result 
EndProcedure 
;}

;- 
;- OTHER
;- 

Procedure CipherInfos(info$)
  EnableWindow_(WindowID(0), 0)
  OpenWindow(1, 0,0, 190,202, #PB_Window_WindowCentered|#PB_Window_SystemMenu|#PB_Window_TitleBar, "Cipher Infos", WindowID(0))
  CreateGadgetList(WindowID())
  
  EditorGadget(100, 5,5, 180,165) : SetGadgetText(100, info$)
  CostumButton(101, 51,175, 82,22, "Ok", c1,c2,c3,c4, #PB_Default, bu,bus, bp,bps, bd, 0)
  
  Repeat
    event = WaitWindowEvent()
    If event = #PB_Event_Gadget And EventGadgetID() = 101
      If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
        Break
      EndIf
    EndIf
  Until event = #PB_Event_CloseWindow
  
  EnableWindow_(WindowID(0), 1)
  CloseWindow(1)
EndProcedure

OpenWindow(0, 0,0, 320,161, #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_TitleBar, "Cookie Cipher 0.7")
CreateGadgetList(WindowID())

SetWinBackgroundColor(WindowID(), RGB(231,224,211))

SetWindowCallback(@Callback()) 

StringGadget(1, 5,6, 45,20, "Input", #PB_String_ReadOnly)
StringGadget(2, 53,6, 233,20, "")
CostumButton(3, 290,5, 25,22, "", c1,c2,c3,c4, #PB_Default, bu2,bus2, bp2,bps2, bd2, 0)

StringGadget(4, 5,31, 45,20, "Output", #PB_String_ReadOnly)
StringGadget(5, 53,31, 233,20, "")
CostumButton(6, 290,30, 25,22, "", c1,c2,c3,c4, #PB_Default, bu2,bus2, bp2,bps2, bd2, 0)

Frame3DGadget(50, 5,57, 310,70, "Password")

StringGadget(7, 15,74, 55,20, "Password", #PB_String_ReadOnly)
StringGadget(8, 73,74, 233,20, "")

StringGadget(10, 15,97, 55,20, "Key", #PB_String_ReadOnly)
StringGadget(11, 73,97, 233,20, "")

CostumButton(12, 5,134, 82,22, "Encode", c1,c2,c3,c4, #PB_Default, bu,bus, bp,bps, bd, 0)
CostumButton(13, 90,134, 82,22, "Decode", c1,c2,c3,c4, #PB_Default, bu,bus, bp,bps, bd, 0)
CostumButton(14, 235,134, 82,22, "Help/Info", c1,c2,c3,c4, #PB_Default, bu,bus, bp,bps, bd, 0)

Global lastin$, lastout$, lpatin, lpatout

Repeat
  event = WaitWindowEvent()
  Select event
    Case #PB_Event_Gadget
    
      Select EventGadgetID()
        Case 3
          If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
            infile$ = OpenFileRequester("Cookie Cipher", lastin$, "Text Files (*.txt)|*.txt|Cookie Cipher Files(*.ccf)|*.ccf|All Files (*.*)|*.*", lpatin)
            If infile$
              lastin$ = infile$
              lpatin = SelectedFilePattern()
              SetGadgetText(2, infile$)
            EndIf
          EndIf
        
        Case 6
          If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
            outfile$ = SaveFileRequester("Cookie Cipher", lastout$, "Text Files (*.txt)|*.txt|Cookie Cipher Files(*.ccf)|*.ccf|All Files (*.*)|*.*", lpatout)
            If outfile$
              lastout$ = outfile$
              lpatout = SelectedFilePattern()
              SetGadgetText(5, outfile$)
            EndIf
          EndIf
        
        Case 12
          If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
            If Len(GetGadgetText(8)) >= 1 And Len(GetGadgetText(11)) = 2
              If ReadFile(0, GetGadgetText(2))
                If CreateFile(1, GetGadgetText(5))
                  If EncodeCCFile(0, 1, GetGadgetText(8), GetGadgetText(11))
                    CloseFile(1)
                    CloseFile(0)
                    info$ = "Succesfully encoded!" + Chr(10)
                    info$ + "***" + Chr(10)
                    info$ + "Input File Name: " + GetFilePart(GetGadgetText(2)) + Chr(10)
                    info$ + "Input File Size: " + Str(FileSize(GetGadgetText(2))) + Chr(10)
                    info$ + "***" + Chr(10)
                    info$ + "Output File Name: " + GetFilePart(GetGadgetText(5)) + Chr(10)
                    info$ + "Output File Size: " + Str(FileSize(GetGadgetText(5)))
                    CipherInfos(info$)
                  Else
                    CloseFile(1)
                    CloseFile(0)
                  EndIf
                Else
                  MessageRequester("Cookie Cipher", "Error on opening Output file!")
                   CloseFile(0)
                EndIf
              Else
                MessageRequester("Cookie Cipher", "Error on opening Input file!")
              EndIf
            Else
              MessageRequester("Cookie Cipher", "Incorrect Password(>=1 char) / Key(2 chars).")
            EndIf
          EndIf
        
        Case 13
          If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
            If Len(GetGadgetText(8)) >= 1 And Len(GetGadgetText(11)) = 2
              If ReadFile(0, GetGadgetText(2))
                If CreateFile(1, GetGadgetText(5))
                  If DecodeCCFile(0, 1, GetGadgetText(8), GetGadgetText(11))
                    CloseFile(1)
                    CloseFile(0)
                    info$ = "Succesfully decoded!" + Chr(10)
                    info$ + "***" + Chr(10)
                    info$ + "Input File Name: " + GetFilePart(GetGadgetText(2)) + Chr(10)
                    info$ + "Input File Size: " + Str(FileSize(GetGadgetText(2))) + Chr(10)
                    info$ + "***" + Chr(10)
                    info$ + "Output File Name: " + GetFilePart(GetGadgetText(5)) + Chr(10)
                    info$ + "Output File Size: " + Str(FileSize(GetGadgetText(5)))
                    CipherInfos(info$)
                    CloseFile(1)
                  Else
                    CloseFile(1)
                    CloseFile(0)
                    info$ = "Decoding failed..." + Chr(10)
                    info$ + "Wrong Password/Key?"
                    CipherInfos(info$)
                  EndIf
                Else
                  MessageRequester("Cookie Cipher", "Error on opening Output file!")
                   CloseFile(0)
                EndIf
              Else
                MessageRequester("Cookie Cipher", "Error on opening Input file!")
              EndIf
            Else
              MessageRequester("Cookie Cipher", "Incorrect Password(>=1 char) / Key(2 chars).")
            EndIf
          EndIf
        
        Case 14
          If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
            RunProgram("readme.rtf")
          EndIf
        
      EndSelect
    
  EndSelect
Until event = #PB_Event_CloseWindow