How do you create a slider control? ( i think Microsoft calls it a TrackBar? )
I need two sliders ,
1: goes from 8 to 1024 in steps of 8
2: goes from 1 to 128 in steps of 1
I'm going to change Vari_Cyph to have sliders instead of up and down buttons.
Slider Ctrl
-
D.J.Peters
- Posts: 8586
- Joined: May 28, 2005 3:28
- Contact:
Re: Slider Ctrl
You can try fltk-c it's really easy
Joshy
Joshy
Code: Select all
#include once "fltk-c.bi"
sub Slider1CB cdecl(byval self as FL_WIDGET ptr,byval sld as any ptr)
print "Slider1CB: " & Fl_ValuatorGetValue(sld)
end sub
sub Slider2CB cdecl(byval self as FL_WIDGET ptr,byval sld as any ptr)
print "Slider2CB: " & Fl_ValuatorGetValue(sld)
end sub
'
' main
'
var win = Fl_WindowNew(150,240)
var sld1 = Fl_SliderNew(30, 35, 30,170)
Fl_WidgetSetCallbackArg sld1,@Slider1CB,sld1
var sld2 = Fl_SliderNew(90, 35, 30,170)
Fl_WidgetSetCallbackArg sld2,@Slider2CB,sld2
Fl_ValuatorSetStep sld1,8
Fl_ValuatorBounds sld1,8,1024
Fl_ValuatorSetStep sld2,1
Fl_ValuatorBounds sld2,1,128
Fl_WindowShow win
Fl_Run
Re: Slider Ctrl
@D.J.Peters
FreeBASIC 1.05 doesn't come with the fltk-c.bi , lib and include...
I just want 2 regular Windows TrackBars.
FreeBASIC 1.05 doesn't come with the fltk-c.bi , lib and include...
I just want 2 regular Windows TrackBars.
Re: Slider Ctrl
This is not really too easy, all the constants are in commctrl.h.
But I have made your 1 to 128 bar on the main window with a static box showing the readings.
But I have made your 1 to 128 bar on the main window with a static box showing the readings.
Code: Select all
#define WIN_INCLUDEALL
#Include Once "windows.bi"
'trackbar constants are in commctrl.h"
#define TBS_AUTOTICKS 1
#define TBS_ENABLESELRANGE 32
#define TRACKBAR_CLASSW "msctls_trackbar32"
#define TRACKBAR_CLASS TRACKBAR_CLASSW
#define TBM_SETRANGE (WM_USER+6)
#define TBM_GETPOS (WM_USER)
'for blue frame on message
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Sub CreateMessageWindow
' Globals (unavoidable)
Dim Shared As HFONT guiFont
Dim Shared As zString * 255 textMessage="start"
Dim Shared As Long flag
Dim Shared As HWND MainWindow, MessageWindow
Dim Shared As HWND EditBox, Button,msgon,bar,label
Dim Shared As Long trackpos
Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Select Case hWnd
Case MainWindow
Select Case msg
Case WM_HSCROLL''TRACKBAR
If Hiword(wparam)<>0 Then trackpos=Hiword(wparam)
setwindowtext(label,Str(trackpos))
Case WM_PAINT
Dim As PAINTSTRUCT ps
BeginPaint(hWnd, @ps)
FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(0, 100, 255)))
EndPaint(hWnd, @ps)
Case WM_CLOSE
PostQuitMessage(NULL)
Case WM_COMMAND
Select Case lParam
Case msgon
CreateMessageWindow
End Select
End Select
Case MessageWindow
Select Case msg
Case WM_COMMAND
Select Case lParam
Case Button
GetWindowText(EditBox, @textMessage, 255)
flag=0'''''''''''''''''''''
destroywindow(messagewindow)''''''''''''''''''''''
End Select
Case WM_CLOSE
flag=0
End Select
End Select
Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function
' Create window class:
Dim As WNDCLASS wcls
With wcls
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = Cast(WNDPROC, @WndProc)
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = GetStockObject(WHITE_BRUSH)
.lpszMenuName = NULL
.lpszClassName = Strptr("WindowClass")
End With
If RegisterClass(@wcls) = FALSE Then
MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
End
End If
MainWindow = CreateWindowEx(NULL, "WindowClass", "MainWindow", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 800, 600, NULL, NULL, NULL, NULL)
msgon= CreateWindowEx(NULL, "Button", "Messages", WS_VISIBLE Or WS_CHILD , 10, 40, 90, 24, MainWindow, NULL, NULL, NULL)
'TRACKBAR STUFF
bar= CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 100, 250, 200, 40, mainwindow,NULL, NULL, NULL)
label= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 100, 150, 200, 40, mainwindow,NULL, NULL, NULL)
SendMessage(bar, TBM_SETRANGE,TRUE, MAKELONG(1,128))'TRACKBAR 1 to 128
'SendMessage(bar, TBM_GETPOS, 0, 0) ??
'SetFocus(bar) ??
Sub CreateMessageWindow
If flag=0 Then
flag=1
MessageWindow = CreateWindowEx(NULL, "WindowClass", "Messages", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
SetWindowTheme(messagewindow," "," ")'''''''''''''''''''''
End If
End Sub
Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
TranslateMessage(@uMsg)
DispatchMessage(@uMsg)
Wend
Re: Slider Ctrl
@Dodicat
It works...
How do you set one up that goes 1 to 1024 in steps of 8?
It works...
How do you set one up that goes 1 to 1024 in steps of 8?
Re: Slider Ctrl
Well here it is in steps one.
I'll have another mess around, but it's getting late over here.
(Anyway, where's the Linux gone?)
EDIT
Here from 8 to 1024 in steps of eight:
I'll have another mess around, but it's getting late over here.
(Anyway, where's the Linux gone?)
EDIT
Here from 8 to 1024 in steps of eight:
Code: Select all
#define WIN_INCLUDEALL
#Include Once "windows.bi"
#Include once "/win/commctrl.bi"
'for blue frame on message
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Sub CreateMessageWindow
' Globals (unavoidable)
Dim Shared As HFONT guiFont
Dim Shared As zString * 255 textMessage="Edited 27/02/17"
Dim Shared As Long flag
Dim Shared As HWND MainWindow, MessageWindow
Dim Shared As HWND EditBox, Button,msgon,bar,label,bar2,label2
Dim Shared As Long trackpos
Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Select Case hWnd
Case MainWindow
Select Case msg
Case WM_HSCROLL'''TRACKBARS
Select Case lparam
Case bar
trackpos= SendMessage(bar, TBM_GETPOS, 0, 0)
setwindowtext(label,Str(trackpos))
Case bar2
trackpos= SendMessage(bar2, TBM_GETPOS, 0, 0)*8
setwindowtext(label2,Str(trackpos))
End Select
Case WM_PAINT
Dim As PAINTSTRUCT ps
BeginPaint(hWnd, @ps)
FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(0, 100, 255)))
EndPaint(hWnd, @ps)
Case WM_CLOSE
PostQuitMessage(NULL)
Case WM_COMMAND
Select Case lParam
Case msgon
CreateMessageWindow
End Select
End Select
Case MessageWindow
Select Case msg
Case WM_COMMAND
Select Case lParam
Case Button
GetWindowText(EditBox, @textMessage, 255)
flag=0
destroywindow(messagewindow)
End Select
Case WM_CLOSE
flag=0
End Select
End Select
Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function
' Create window class:
Dim As WNDCLASS wcls
With wcls
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = Cast(WNDPROC, @WndProc)
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = GetStockObject(WHITE_BRUSH)
.lpszMenuName = NULL
.lpszClassName = Strptr("WindowClass")
End With
If RegisterClass(@wcls) = FALSE Then
MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
End
End If
MainWindow = CreateWindowEx(NULL, "WindowClass", "MainWindow", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 800, 600, NULL, NULL, NULL, NULL)
msgon= CreateWindowEx(NULL, "Button", "Messages", WS_VISIBLE Or WS_CHILD , 10, 40, 90, 24, MainWindow, NULL, NULL, NULL)
'TRACKBAR STUFF
bar= CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 100, 250, 200, 40, mainwindow,NULL, NULL, NULL)
bar2= CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 100, 400, 200, 40, mainwindow,NULL, NULL, NULL)
label= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 100, 200, 200, 40, mainwindow,NULL, NULL, NULL)
label2= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 100, 350, 200, 40, mainwindow,NULL, NULL, NULL)
SendMessage(bar, TBM_SETRANGE,TRUE, MAKELONG(1,128))'TRACKBAR 1 to 128
SendMessage(bar2, TBM_SETRANGE,TRUE, MAKELONG(1,1024\8))'TRACKBAR 1 to 128 but adjusted steps 8 - line 31
'SetFocus(bar) ??
Sub CreateMessageWindow
If flag=0 Then
flag=1
MessageWindow = CreateWindowEx(NULL, "WindowClass", "Messages", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
SetWindowTheme(messagewindow," "," ")' optional
End If
End Sub
Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
TranslateMessage(@uMsg)
DispatchMessage(@uMsg)
Wend
Last edited by dodicat on Feb 27, 2017 11:22, edited 1 time in total.
Re: Slider Ctrl
@Dodicat
Thanks!! , Your my hero!
They both work good!.. Vari_Cyph_FB_V_12 should be out in a couple days.
I sped up the Cypher routine , and animated the "Cypher" button ,
so for real long files , like several kilobytes , it doesn't leave you guessing if it locked up or not.
It can Cypher the *.bas file into 1024 x 128 in under a minute..
Thanks!! , Your my hero!
They both work good!.. Vari_Cyph_FB_V_12 should be out in a couple days.
I sped up the Cypher routine , and animated the "Cypher" button ,
so for real long files , like several kilobytes , it doesn't leave you guessing if it locked up or not.
It can Cypher the *.bas file into 1024 x 128 in under a minute..
Re: Slider Ctrl
@Dodicat
I got it working !!! I figured it out finally ...
I got it working !!! I figured it out finally ...
Code: Select all
'VariCyph FreeBasic Version 12.0
'
'Written by Albert Redditt
'
'albert_redditt@yahoo.com
#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"
#Include once "file.bi"
'===============================================================================
'===============================================================================
'Private function fb_Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
' Dim As HDC hDC=GetDC(HWND_DESKTOP)
' Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
' ReleaseDC(HWND_DESKTOP,hDC)
' Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,OEM_CHARSET _
' ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
'End Function
'Dim As HFONT fonthdl
'Dim As String fontname
'Dim As Integer fontsize = 8
'fontname = "FixedSys" ' "Courier new"
'fonthdl = fb_Set_Font(fontname,fontsize,TRUE,0,0,0)
'===============================================================================
'===============================================================================
Dim Shared As Long trackpos1 , getlast1
Dim Shared As Long trackpos2 , getlast2
'===============================================================================
'===============================================================================
Dim shared as integer TabPages : TabPages = 1
Dim Shared as integer GarbageBits : GarbageBits = 64
Dim Shared as integer GarbageBytes: GarbageBytes = 1
'===============================================================================
'===============================================================================
const Keys_Spinner_Val_max = 1024
const Keys_Spinner_val_min = 8
const Keys_Spinner_val_inc = 8
dim shared as uinteger Keys_Spinner_val = 8
const Garbage_Spinner_Val_max = 128
const Garbage_Spinner_val_min = 1
const Garbage_Spinner_val_inc = 1
dim shared as uinteger Garbage_Spinner_val = 1
'===============================================================================
'===============================================================================
dim shared as string file , extension , FileData
Redim shared as integer Key(0 to (64*TabPages)-1)
Redim shared as Ubyte SubKey(0 to 15)
for a as longint = lbound(key) to ubound(key)
key(a) = a
next
Declare sub PrintKey()
Declare sub LoadCypheredText()
Declare sub Cypher()
Declare sub DeCypher()
Declare sub GetKeys()
Declare sub LoadKey()
Declare sub SaveKey()
Declare sub SaveOutput()
Declare sub GenerateKey()
Declare sub GenerateSubKey()
Declare sub CopyOutputToInput()
Declare sub MessageSpinner_Up()
Declare sub MessageSpinner_Dn()
Declare sub MessageSize()
Declare sub GarbageSpinner_Up()
Declare sub GarbageSpinner_Dn()
Declare sub GarbageSize()
Declare sub GetFileName()
ReDim shared as hwnd STATICS(1 to TabPages)
ReDim shared as hwnd EDIT_KEY(1 to TabPages,1 to 8,1 to 8)
Dim shared as string Help_Text
Help_Text = "This encoder is a bit scrambler. (It can only load ASCII text files 8 bit.)" + chr(13) + chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "It scrambles message bytes amongst several times as many garbage bytes." + chr(13) + chr(10)
Help_Text+= "You select the number of message bytes. in multiples of 8" + chr(13) + chr(10)
Help_Text+= "Then" + chr(13) + chr(10)
Help_Text+= "You select the number of garbage bytes as a multiple of message bytes 1x , 2x , 4x etc.." + chr(13) + chr(10)
Help_Text+= "If garbage is set to 4 then the output will be 4 times as long as the message bytes." + chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "If message bytes is set to 16 then the message is broken into chunks of 16 bytes." + chr(13) + chr(10)
Help_Text+= "Message blocks can be any multiple of 8 , up to 1024."+chr(13)+chr(10)
Help_Text+= "Garbage blocks can be any multiple of MessageBlocks up to 128."+chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "Written in FreeBasic for Windows , by albert_redditt@yahoo.com"
Dim shared As MSG msg ' Message variable (stores massages)
Dim shared As HWND hWnd _
, EDIT_IN _
, EDITKEY _
, STATIC_OUTS(0 to 15) _
, EDIT_OUTS(0 to 15) _
, EDIT_OUT _
, LOADCYPHTEXT_BTN _
, CYPHER_BTN _
, DECYPHER_BTN _
, LOADKEY_BTN _
, SAVEKEY_BTN _
, GENERATEKEY_BTN _
, label1 _
, MESSAGE_SIZE _
, label2 _
, GARBAGE_SIZE _
, HELP _
, GENERATESUBKEY_BTN _
, SAVEOUTPUT_BTN _
, COPY_OUTPUT_TO_INPUT _ 'for multiple cyphering.
, TrackBar1 _
,TrackBar2
'===============================================================================
' Create window
hWnd = CreateWindowEx( 0, "#32770", "Vari_Cyph_FB_V12 Feb / 2017", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 600, 600, 0, 0, 0, 0 )
'create in edit
EDIT_IN = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL , 10, 10,430,110, hWnd, 0, 0, 0 )
'SendMessage(EDIT_IN,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create readonly edit out
EDIT_OUT = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,430,430,130, hWnd, 0, 0, 0 )
'SendMessage(EDIT_OUT,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create key edit
EDITKEY = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,125,430,215, hWnd, 0, 0, 0 )
'create labels and edits for output.
dim as integer count1
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
count1 = ((y*8)-8)+x-1
SubKey(count1)=(65+count1)
STATIC_OUTS(count1) = CreateWindowEx( 0,"STATIC", right("0000" + bin(count1),4), WS_VISIBLE Or WS_CHILD ,(x*38)-38+(15*x) ,280+( (y*12)+20+(32*y)) , 38, 20, hWnd, 0, 0, 0 )
EDIT_OUTS( count1 ) = CreateWindowEx( 0,"EDIT" , CHR(SubKey(count1)) , WS_VISIBLE Or WS_CHILD Or WS_BORDER,(x*38)-30+(15*x) ,305+( (y*12)+10+(32*y)) , 18, 20, hWnd, 0, 0, 0 )
next
next
LOADCYPHTEXT_BTN = CreateWindowEx( 0,"BUTTON" , "Load Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,10 , 100, 25, hWnd, 0, 0, 0 )
CYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,50 , 100, 25, hWnd, 0, 0, 0 )
DECYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "DeCypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,90 , 100, 25, hWnd, 0, 0, 0 )
LOADKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Load Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,130 , 100, 25, hWnd, 0, 0, 0 )
SAVEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Save Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,160 , 100, 25, hWnd, 0, 0, 0 )
GENERATEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Generate Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,190 , 100, 25, hWnd, 0, 0, 0 )
label1 = CreateWindowEx( 0,"STATIC" , "Message Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,225 , 100, 20, hWnd, 0, 0, 0 )
MESSAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(TabPages*8) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,245 , 100, 25, hWnd, 0, 0, 0 )
TrackBar1 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 270,120, 35, hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(1,1024\8))'TRACKBAR 1 to 128
label2 = CreateWindowEx( 0,"STATIC" , "Garbage Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,310 , 100, 20, hWnd, 0, 0, 0 )
GARBAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(GarbageBytes) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,330 , 100, 25, hWnd, 0, 0, 0 )
TrackBar2 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 355,120, 35, hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(1,128))'TRACKBAR 1 to 128
GENERATESUBKEY_BTN= CreateWindowEx( 0,"BUTTON" ,"Generate SubKey", WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,395 , 130, 25, hWnd, 0, 0, 0 )
SAVEOUTPUT_BTN = CreateWindowEx( 0,"BUTTON" , "Save Output" , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,435 , 130, 25, hWnd, 0, 0, 0 )
COPY_OUTPUT_TO_INPUT = CreateWindowEx( 0,"BUTTON" , "Copy to Input", WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,480 , 130, 25, hWnd, 0, 0, 0 )
HELP = CreateWindowEx( 0,"BUTTON" , "Help" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,525 , 130, 25, hWnd, 0, 0, 0 )
'End Control setup
PrintKey()
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
dim as WPARAM wparam
dim as LPARAM lparam
TranslateMessage( @msg )
DispatchMessage( @msg )
Select Case msg.hwnd
Case hWnd
Select Case msg.message
Case 273
PostQuitMessage(0)
'End
End Select
case TrackBar1
Select Case msg.message
case WM_MOUSEMOVE
trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0) *8
if trackpos1 <> getlast1 then
setwindowtext(MESSAGE_SIZE,Str(trackpos1))
MessageSize()
getlast1 = trackpos1
end if
End Select
case TrackBar2
Select Case msg.message
case WM_MOUSEMOVE
trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
if trackpos2 <> getlast2 then
setwindowtext(GARBAGE_SIZE,Str(trackpos2))
MessageSize()
getlast2 = trackpos2
end if
End Select
Case LOADCYPHTEXT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadCypheredText()
End Select
Case CYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
Cypher()
End Select
Case DECYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
DeCypher()
End Select
Case LOADKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadKey()
End Select
Case SAVEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveKey()
End Select
Case HELP
select case msg.message
case WM_LBUTTONDOWN
MessageBox(0,Help_Text,"Help",MB_OK)
end select
Case SAVEOUTPUT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveOutput()
End Select
Case COPY_OUTPUT_TO_INPUT
select Case msg.message
case WM_LBUTTONDOWN
CopyOutputToInput()
end select
Case GENERATEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateKey()
End Select
Case GENERATESUBKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateSubKey()
End Select
End Select
Wend
PostQuitMessage(0)
END
'===============================================================================
'===============================================================================
'subs and functions below here
'===============================================================================
'===============================================================================
sub MessageSpinner_Up()
if Keys_Spinner_val < Keys_Spinner_val_max then Keys_Spinner_val+= Keys_Spinner_val_inc
SetWindowText(MESSAGE_SIZE,str(Keys_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub MessageSpinner_Dn()
if Keys_Spinner_val > Keys_Spinner_val_min then Keys_Spinner_val-= Keys_Spinner_val_inc
SetWindowText(MESSAGE_SIZE,str(Keys_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub MessageSize()
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Keys_Spinner_val = val(textin)
if Keys_Spinner_val > Keys_Spinner_Val_max = 1024 then
Keys_Spinner_val = Keys_Spinner_val_max
end if
dim as string str1
dim as integer dec1
do
str1=str(Keys_Spinner_val/8)
dec1=instr(1,str1,".")
if dec1<>0 then Keys_Spinner_val+=1
loop until dec1 = 0
SetWindowText(MESSAGE_SIZE,str(Keys_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GarbageSpinner_Up()
if Garbage_Spinner_val < Garbage_Spinner_val_max then Garbage_Spinner_val+= Garbage_Spinner_val_inc
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
SetWindowText(GARBAGE_SIZE,str(Garbage_Spinner_val))
end sub
'===============================================================================
'===============================================================================
sub GarbageSpinner_Dn()
if Garbage_Spinner_val > Garbage_Spinner_val_min then Garbage_Spinner_val-= Garbage_Spinner_val_inc
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
SetWindowText(GARBAGE_SIZE,str(Garbage_Spinner_val))
End Sub
'===============================================================================
'===============================================================================
sub GarbageSize()
dim as string*6 textin
GetWindowText(GARBAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Garbage_Spinner_val = val(textin)
if Garbage_Spinner_val > Garbage_Spinner_val_max then
Garbage_Spinner_val = Garbage_Spinner_val_max
end if
SetWindowText(GARBAGE_SIZE,str(Garbage_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub PrintKey()
dim as string KeyText
dim as longint count = 1
for a as longint = lbound(key) to ubound(Key)
if a mod 8 = 0 then KeyText+=right("____" + str(count),4)+")"
KeyText+=right("________"+str(key(a)),8)
if a mod 8 = 7 then KeyText +=chr(13)+chr(10) : count+=1
next
SETWINDOWTEXT( EDITKEY , KeyText)
end sub
'===============================================================================
'===============================================================================
sub LoadCypheredText()
'can only load ascii text files
GetFileName()
FileData=""
if fileexists(file) then
dim as string char
open file for input as #1
do
line input #1 , char
FileData = fileData + (char) + chr(13) + chr(10)
loop until EOF(1)
close #1
FileData = left(FileData,len(FileData)-2)
SetWindowText(EDIT_In,FileData)
FileData=""
file=""
end if
end sub
'===============================================================================
'===============================================================================
sub Cypher()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,Chr(32))
GetInputMessage = trim(GetInputMessage,chr(0))
'make input string an even number of Block sizes
dim as string str1
dim as single dec
do
str1=str( len(GetInputMessage) / (TabPages*8) )
dec=instr(1,str1,".")
if dec<>0 then GetInputMessage+="_" 'if message is not a multiple of (TabPages*8) characters
loop until dec=0
'turn message into binary
dim as string BinaryMessageBlocks
for a as integer = 1 to len(GetInputMessage) step 1
BinaryMessageBlocks+= right("00000000" + bin( asc(mid(GetInputMessage,a,1)) ) ,8)
next
'stick user message bits (TabPages*64/TabPages) into random garbage of length GarbageBits
dim as string MessageBits
dim as string RandomGarbage
dim as string Accumulated
dim as string mytext = ""
SetWindowText( CYPHER_BTN , "Cyphering.." )
sleep 1000
for a as integer = 1 to len(BinaryMessageBlocks) step (64*TabPages)
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
MessageBits = mid(BinaryMessageBlocks,a, 64*tabPages)
RandomGarbage=""
for garbage as integer = 1 to GarbageBits step 8
randomize
RandomGarbage+=right("00000000" + bin(int(rnd*256)) , 8)
next
for insert as integer = lbound(Key) to ubound(Key)
mid(RandomGarbage,Key(insert),1) = mid(MessageBits,insert+1,1)
next
Accumulated+=RandomGarbage
next
dim as string CypheredOutput=""
dim as string*4 QuadBits
dim as ubyte value
dim as longint count = 0
mytext=""
SetWindowText( CYPHER_BTN , "Create Output" )
sleep 1000
for a as integer = 1 to len(Accumulated) step 4
count+=1
if count = 100000 then
count = 0
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
end if
value=0
QuadBits=mid(Accumulated,a,4)
value = val("&B" + QuadBits)
CypheredOutput+=Chr(SubKey(value))
next
SetWindowText(EDIT_OUT,CypheredOutput)
CypheredOutput=""
SetWindowText( CYPHER_BTN , "Cypher")
end sub
'===============================================================================
'===============================================================================
sub DeCypher()
GetKeys()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,chr(0))
if len(GetInputMessage)<>0 then
dim as string BinarySubOutput(1 to (len(GetInputMessage)/(GarbageBits/8)/2) )
dim as string Bites
dim as integer Chunks = (len(GetInputMessage)/(GarbageBits/8)/2)
dim as ubyte Char
Dim as integer Dec=1
for a as integer = 1 to len(GetInputMessage) step (len(GetInputMessage)/Chunks)
Bites = mid( GetInputMessage, a, len(GetInputMessage)/Chunks )
for b as integer = 1 to len(bites)
Char = asc( mid(Bites,b,1) )
for c as integer = 0 to 15
if Char = SubKey(c) then BinarySubOutput(Dec)+=right("0000"+bin(c),4)
next
next
Dec+=1
next
Dec-=1
dim as string Binary_out
for a as integer = 1 to Dec step 1
for b as integer = 0 to ubound(Key)
Binary_Out+= mid(BinarySubOutput(a),Key(b),1)
next
next
dim as string FinalOutput
dim as string*8 OctaBits
for a as integer = 1 to len(Binary_Out) step 8
OctaBits = mid(Binary_Out,a,8)
mid(Binary_Out,a,8)="00000000"
Dec=0
if mid(OctaBits,1,1)="1" then Dec+=128
if mid(OctaBits,2,1)="1" then Dec+= 64
if mid(OctaBits,3,1)="1" then Dec+= 32
if mid(OctaBits,4,1)="1" then Dec+= 16
if mid(OctaBits,5,1)="1" then Dec+= 8
if mid(OctaBits,6,1)="1" then Dec+= 4
if mid(OctaBits,7,1)="1" then Dec+= 2
if mid(OctaBits,8,1)="1" then Dec+= 1
FinalOutput+=Chr(Dec)
next
FinalOutput = rtrim(FinalOutput,"_")
SetWindowText(EDIT_OUT,FinalOutput)
end if
end sub
'===============================================================================
'===============================================================================
sub GetKeys()
dim as string*1 CharSubKey
for a as integer = 1 to 2
for b as integer = 1 to 8
'print ((a*8)-8) +b-1
GetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , CharSubKey , 2)
SubKey( ((a*8)-8)+b-1 ) = asc(CharSubKey)
next
next
end sub
'===============================================================================
'===============================================================================
sub LoadKey()
GetFileName()
if fileexists(file) then
open file for input as #1
dim as String Inputs
line input #1 , Inputs
SetWindowText(MESSAGE_SIZE,Inputs)
Keys_Spinner_Val = val(inputs)
MessageSize()
line input #1 , Inputs
SetWindowText(GARBAGE_SIZE,Inputs)
Garbage_spinner_val = val(inputs)
GarbageSize()
Redim Key(0 to Keys_Spinner_val*8-1)
Redim SubKey(0 to 15)
dim as ulongint count
count=0
do
line input #1 , Inputs
Key(count) = val(Inputs)
count+=1
loop until count > ubound(Key)
count=0
do
line input #1 , Inputs
SubKey(count) = val(Inputs)
count+=1
loop until count = 16
Close #1
PrintKey()
dim as integer dec
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
Dec = (((y*8)-8)+x)-1
'print y,x,Dec,SubKey(Dec)
SetWindowText(EDIT_OUTS( Dec ) , chr(SubKey(Dec)) )
next
next
file=""
extension=""
end if
end sub
'===============================================================================
'===============================================================================
sub SaveKey()
getkeys()
GetFileName()
dim as string SaveKeys = ""
if file<>"" then
open file for output as #1
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
print #1 , textin
GetWindowText(GARBAGE_SIZE,textin,5)
print #1 , textin
for a as integer = lbound(key) to ubound(key)
print #1 , str(Key(a))
next
for a as integer = 0 to 15
Print #1 , SubKey(a)
next
close #1
end if
end sub
'===============================================================================
'===============================================================================
sub SaveOutput()
GetFileName()
if file<>"" then
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
open file for output as #1
print #1 , GetOutputMessage
close #1
end if
end sub
'===============================================================================
'===============================================================================
Sub CopyOutputToInput()
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
SetWindowText(EDIT_IN , GetOutputMessage)
SetWindowText(EDIT_OUT , "")
end sub
'===============================================================================
'===============================================================================
sub GenerateKey()
' ((a*64)-64)+((x*8)-8)+y
Redim Key(0 to (TabPages*64-1) )
dim a as integer
dim b as integer
dim c as integer
dim d as integer
'create random key for main cypher.
for a = 0 to (TabPages*64)-1
key(a) = 0
next
a=0
do
b = int(rnd*GarbageBits)+1
randomize b / sin(rnd*timer) / tan(timer/1000)
do
b = int(rnd*GarbageBits)+1
d = 0
for c = 0 to a
if key(c) = b then d = 1
next
loop until d = 0
key(a) = b
a = a + 1
loop until a=(TabPages*64)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GenerateSubKey()
Redim SubKey(0 to 15)
'create 16 letter subsitution for output
dim a as integer
dim b as integer
dim c as integer
dim d as integer
for a = 0 to 15
SubKey(a) = 0
next
a=0
do
b = int( rnd*26 )+65
do
b = int( rnd*26 )+65
d = 0
for c=0 to a
if SubKey(c) = b then d = 1
next
loop until d = 0
SubKey(a) = b
a=a+1
loop until a=16
'answer = ((a*8)-8) +b
for a = 1 to 2
for b = 1 to 8
'print ((a*8)-8) +b-1
SetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , chr( SubKey( ((a*8)-8)+b-1 ) ) )
next
next
end sub
'===============================================================================
'===============================================================================
sub getfilename()
dim ofn as OPENFILENAME
dim filename as zstring * MAX_PATH+1
with ofn
.lStructSize = sizeof( OPENFILENAME )
.hwndOwner = hWnd
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = strptr( !"All Files, (*.*)\0*.*\0\0" )
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = 1
.lpstrFile = @filename
.nMaxFile = sizeof( filename )
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = NULL
.lpstrTitle = @"File To Open."
.Flags = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
end with
if( GetOpenFileName( @ofn ) = FALSE ) then
file = ""
extension=""
return
else
file = filename
extension = right$(filename,4)
end if
end sub
Re: Slider Ctrl
Works well Albert.
I see that the trackbar constants are in /win/commctrl.bi.
Win 10 must have missed them when I searched the names.
Also SendMessage(bar, TBM_GETPOS, 0, 0) is better than Hiword(wparam) for the slider values, so I have altered my own code accordingly.
I see that the trackbar constants are in /win/commctrl.bi.
Win 10 must have missed them when I searched the names.
Also SendMessage(bar, TBM_GETPOS, 0, 0) is better than Hiword(wparam) for the slider values, so I have altered my own code accordingly.
Re: Slider Ctrl
@Dodicat
At line 219 , i think theres was an error it called "MessageSize() instead of "GarbageSize()"
Here it is with the fix..
How do you set the position of the trackbar ??
Function LoadKey() needs to set the 2 trackbar positions..
At line 219 , i think theres was an error it called "MessageSize() instead of "GarbageSize()"
Here it is with the fix..
How do you set the position of the trackbar ??
Function LoadKey() needs to set the 2 trackbar positions..
Code: Select all
'VariCyph FreeBasic Version 12.0
'
'Written by Albert Redditt
'
'albert_redditt@yahoo.com
#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"
#Include once "file.bi"
'===============================================================================
'===============================================================================
'Private function fb_Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
' Dim As HDC hDC=GetDC(HWND_DESKTOP)
' Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
' ReleaseDC(HWND_DESKTOP,hDC)
' Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,OEM_CHARSET _
' ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
'End Function
'Dim As HFONT fonthdl
'Dim As String fontname
'Dim As Integer fontsize = 8
'fontname = "FixedSys" ' "Courier new"
'fonthdl = fb_Set_Font(fontname,fontsize,TRUE,0,0,0)
'===============================================================================
'===============================================================================
Dim Shared As Long trackpos1 , getlast1
Dim Shared As Long trackpos2 , getlast2
'===============================================================================
'===============================================================================
Dim shared as integer TabPages : TabPages = 1
Dim Shared as integer GarbageBits : GarbageBits = 64
Dim Shared as integer GarbageBytes: GarbageBytes = 1
'===============================================================================
'===============================================================================
const Keys_Spinner_Val_max = 1024
const Keys_Spinner_val_min = 8
const Keys_Spinner_val_inc = 8
dim shared as uinteger Keys_Spinner_val = 8
const Garbage_Spinner_Val_max = 128
const Garbage_Spinner_val_min = 1
const Garbage_Spinner_val_inc = 1
dim shared as uinteger Garbage_Spinner_val = 1
'===============================================================================
'===============================================================================
dim shared as string file , extension , FileData
Redim shared as integer Key(0 to (64*TabPages)-1)
Redim shared as Ubyte SubKey(0 to 15)
for a as longint = lbound(key) to ubound(key)
key(a) = a
next
Declare sub PrintKey()
Declare sub LoadCypheredText()
Declare sub Cypher()
Declare sub DeCypher()
Declare sub GetKeys()
Declare sub LoadKey()
Declare sub SaveKey()
Declare sub SaveOutput()
Declare sub GenerateKey()
Declare sub GenerateSubKey()
Declare sub CopyOutputToInput()
Declare sub MessageSpinner_Up()
Declare sub MessageSpinner_Dn()
Declare sub MessageSize()
Declare sub GarbageSpinner_Up()
Declare sub GarbageSpinner_Dn()
Declare sub GarbageSize()
Declare sub GetFileName()
ReDim shared as hwnd STATICS(1 to TabPages)
ReDim shared as hwnd EDIT_KEY(1 to TabPages,1 to 8,1 to 8)
Dim shared as string Help_Text
Help_Text = "This encoder is a bit scrambler. (It can only load ASCII text files 8 bit.)" + chr(13) + chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "It scrambles message bytes amongst several times as many garbage bytes." + chr(13) + chr(10)
Help_Text+= "You select the number of message bytes. in multiples of 8" + chr(13) + chr(10)
Help_Text+= "Then" + chr(13) + chr(10)
Help_Text+= "You select the number of garbage bytes as a multiple of message bytes 1x , 2x , 4x etc.." + chr(13) + chr(10)
Help_Text+= "If garbage is set to 4 then the output will be 4 times as long as the message bytes." + chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "If message bytes is set to 16 then the message is broken into chunks of 16 bytes." + chr(13) + chr(10)
Help_Text+= "Message blocks can be any multiple of 8 , up to 1024."+chr(13)+chr(10)
Help_Text+= "Garbage blocks can be any multiple of MessageBlocks up to 128."+chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "Written in FreeBasic for Windows , by albert_redditt@yahoo.com"
Dim shared As MSG msg ' Message variable (stores massages)
Dim shared As HWND hWnd _
, EDIT_IN _
, EDITKEY _
, STATIC_OUTS(0 to 15) _
, EDIT_OUTS(0 to 15) _
, EDIT_OUT _
, LOADCYPHTEXT_BTN _
, CYPHER_BTN _
, DECYPHER_BTN _
, LOADKEY_BTN _
, SAVEKEY_BTN _
, GENERATEKEY_BTN _
, label1 _
, MESSAGE_SIZE _
, label2 _
, GARBAGE_SIZE _
, HELP _
, GENERATESUBKEY_BTN _
, SAVEOUTPUT_BTN _
, COPY_OUTPUT_TO_INPUT _ 'for multiple cyphering.
, TrackBar1 _
,TrackBar2
'===============================================================================
' Create window
hWnd = CreateWindowEx( 0, "#32770", "Vari_Cyph_FB_V12 Feb / 2017", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 600, 600, 0, 0, 0, 0 )
'create in edit
EDIT_IN = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL , 10, 10,430,110, hWnd, 0, 0, 0 )
'SendMessage(EDIT_IN,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create readonly edit out
EDIT_OUT = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,430,430,130, hWnd, 0, 0, 0 )
'SendMessage(EDIT_OUT,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create key edit
EDITKEY = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,125,430,215, hWnd, 0, 0, 0 )
'create labels and edits for output.
dim as integer count1
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
count1 = ((y*8)-8)+x-1
SubKey(count1)=(65+count1)
STATIC_OUTS(count1) = CreateWindowEx( 0,"STATIC", right("0000" + bin(count1),4), WS_VISIBLE Or WS_CHILD ,(x*38)-38+(15*x) ,280+( (y*12)+20+(32*y)) , 38, 20, hWnd, 0, 0, 0 )
EDIT_OUTS( count1 ) = CreateWindowEx( 0,"EDIT" , CHR(SubKey(count1)) , WS_VISIBLE Or WS_CHILD Or WS_BORDER,(x*38)-30+(15*x) ,305+( (y*12)+10+(32*y)) , 18, 20, hWnd, 0, 0, 0 )
next
next
LOADCYPHTEXT_BTN = CreateWindowEx( 0,"BUTTON" , "Load Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,10 , 100, 25, hWnd, 0, 0, 0 )
CYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,50 , 100, 25, hWnd, 0, 0, 0 )
DECYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "DeCypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,90 , 100, 25, hWnd, 0, 0, 0 )
LOADKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Load Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,130 , 100, 25, hWnd, 0, 0, 0 )
SAVEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Save Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,160 , 100, 25, hWnd, 0, 0, 0 )
GENERATEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Generate Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,190 , 100, 25, hWnd, 0, 0, 0 )
label1 = CreateWindowEx( 0,"STATIC" , "Message Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,225 , 100, 20, hWnd, 0, 0, 0 )
MESSAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(TabPages*8) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,245 , 100, 25, hWnd, 0, 0, 0 )
TrackBar1 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 270,120, 35, hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(1,1024\8))'TRACKBAR 1 to 128
label2 = CreateWindowEx( 0,"STATIC" , "Garbage Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,310 , 100, 20, hWnd, 0, 0, 0 )
GARBAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(GarbageBytes) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,330 , 100, 25, hWnd, 0, 0, 0 )
TrackBar2 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 355,120, 35, hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(1,128))'TRACKBAR 1 to 128
GENERATESUBKEY_BTN= CreateWindowEx( 0,"BUTTON" ,"Generate SubKey", WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,395 , 130, 25, hWnd, 0, 0, 0 )
SAVEOUTPUT_BTN = CreateWindowEx( 0,"BUTTON" , "Save Output" , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,435 , 130, 25, hWnd, 0, 0, 0 )
COPY_OUTPUT_TO_INPUT = CreateWindowEx( 0,"BUTTON" , "Copy to Input", WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,480 , 130, 25, hWnd, 0, 0, 0 )
HELP = CreateWindowEx( 0,"BUTTON" , "Help" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,525 , 130, 25, hWnd, 0, 0, 0 )
'End Control setup
PrintKey()
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
dim as WPARAM wparam
dim as LPARAM lparam
TranslateMessage( @msg )
DispatchMessage( @msg )
Select Case msg.hwnd
Case hWnd
Select Case msg.message
Case 273
PostQuitMessage(0)
'End
End Select
case TrackBar1
Select Case msg.message
case WM_MOUSEMOVE
trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0) *8
if trackpos1 <> getlast1 then
setwindowtext(MESSAGE_SIZE,Str(trackpos1))
MessageSize()
getlast1 = trackpos1
end if
End Select
case TrackBar2
Select Case msg.message
case WM_MOUSEMOVE
trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
if trackpos2 <> getlast2 then
setwindowtext(GARBAGE_SIZE,Str(trackpos2))
GarbageSize()
getlast2 = trackpos2
end if
End Select
Case LOADCYPHTEXT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadCypheredText()
End Select
Case CYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
Cypher()
End Select
Case DECYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
DeCypher()
End Select
Case LOADKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadKey()
End Select
Case SAVEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveKey()
End Select
Case HELP
select case msg.message
case WM_LBUTTONDOWN
MessageBox(0,Help_Text,"Help",MB_OK)
end select
Case SAVEOUTPUT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveOutput()
End Select
Case COPY_OUTPUT_TO_INPUT
select Case msg.message
case WM_LBUTTONDOWN
CopyOutputToInput()
end select
Case GENERATEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateKey()
End Select
Case GENERATESUBKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateSubKey()
End Select
End Select
Wend
PostQuitMessage(0)
END
'===============================================================================
'===============================================================================
'subs and functions below here
'===============================================================================
'===============================================================================
sub MessageSize()
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Keys_Spinner_val = val(textin)
if Keys_Spinner_val > Keys_Spinner_Val_max = 1024 then
Keys_Spinner_val = Keys_Spinner_val_max
end if
dim as string str1
dim as integer dec1
do
str1=str(Keys_Spinner_val/8)
dec1=instr(1,str1,".")
if dec1<>0 then Keys_Spinner_val+=1
loop until dec1 = 0
SetWindowText(MESSAGE_SIZE,str(Keys_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GarbageSize()
dim as string*6 textin
GetWindowText(GARBAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Garbage_Spinner_val = val(textin)
if Garbage_Spinner_val > Garbage_Spinner_val_max then
Garbage_Spinner_val = Garbage_Spinner_val_max
end if
SetWindowText(GARBAGE_SIZE,str(Garbage_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub PrintKey()
dim as string KeyText
dim as longint count = 1
for a as longint = lbound(key) to ubound(Key)
if a mod 8 = 0 then KeyText+=right("____" + str(count),4)+")"
KeyText+=right("________"+str(key(a)),8)
if a mod 8 = 7 then KeyText +=chr(13)+chr(10) : count+=1
next
SETWINDOWTEXT( EDITKEY , KeyText)
end sub
'===============================================================================
'===============================================================================
sub LoadCypheredText()
'can only load ascii text files
GetFileName()
FileData=""
if fileexists(file) then
dim as string char
open file for input as #1
do
line input #1 , char
FileData = fileData + (char) + chr(13) + chr(10)
loop until EOF(1)
close #1
FileData = left(FileData,len(FileData)-2)
SetWindowText(EDIT_In,FileData)
FileData=""
file=""
end if
end sub
'===============================================================================
'===============================================================================
sub Cypher()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,Chr(32))
GetInputMessage = trim(GetInputMessage,chr(0))
'make input string an even number of Block sizes
dim as string str1
dim as single dec
do
str1=str( len(GetInputMessage) / (TabPages*8) )
dec=instr(1,str1,".")
if dec<>0 then GetInputMessage+="_" 'if message is not a multiple of (TabPages*8) characters
loop until dec=0
'turn message into binary
dim as string BinaryMessageBlocks
for a as integer = 1 to len(GetInputMessage) step 1
BinaryMessageBlocks+= right("00000000" + bin( asc(mid(GetInputMessage,a,1)) ) ,8)
next
'stick user message bits (TabPages*64/TabPages) into random garbage of length GarbageBits
dim as string MessageBits
dim as string RandomGarbage
dim as string Accumulated
dim as string mytext = ""
SetWindowText( CYPHER_BTN , "Cyphering.." )
sleep 1000
for a as integer = 1 to len(BinaryMessageBlocks) step (64*TabPages)
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
MessageBits = mid(BinaryMessageBlocks,a, 64*tabPages)
RandomGarbage=""
for garbage as integer = 1 to GarbageBits step 8
randomize
RandomGarbage+=right("00000000" + bin(int(rnd*256)) , 8)
next
for insert as integer = lbound(Key) to ubound(Key)
mid(RandomGarbage,Key(insert),1) = mid(MessageBits,insert+1,1)
next
Accumulated+=RandomGarbage
next
dim as string CypheredOutput=""
dim as string*4 QuadBits
dim as ubyte value
dim as longint count = 0
mytext=""
SetWindowText( CYPHER_BTN , "Create Output" )
sleep 1000
for a as integer = 1 to len(Accumulated) step 4
count+=1
if count = 100000 then
count = 0
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
end if
value=0
QuadBits=mid(Accumulated,a,4)
value = val("&B" + QuadBits)
CypheredOutput+=Chr(SubKey(value))
next
SetWindowText(EDIT_OUT,CypheredOutput)
CypheredOutput=""
SetWindowText( CYPHER_BTN , "Cypher")
end sub
'===============================================================================
'===============================================================================
sub DeCypher()
GetKeys()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,chr(0))
if len(GetInputMessage)<>0 then
dim as string BinarySubOutput(1 to (len(GetInputMessage)/(GarbageBits/8)/2) )
dim as string Bites
dim as integer Chunks = (len(GetInputMessage)/(GarbageBits/8)/2)
dim as ubyte Char
Dim as integer Dec=1
for a as integer = 1 to len(GetInputMessage) step (len(GetInputMessage)/Chunks)
Bites = mid( GetInputMessage, a, len(GetInputMessage)/Chunks )
for b as integer = 1 to len(bites)
Char = asc( mid(Bites,b,1) )
for c as integer = 0 to 15
if Char = SubKey(c) then BinarySubOutput(Dec)+=right("0000"+bin(c),4)
next
next
Dec+=1
next
Dec-=1
dim as string Binary_out
for a as integer = 1 to Dec step 1
for b as integer = 0 to ubound(Key)
Binary_Out+= mid(BinarySubOutput(a),Key(b),1)
next
next
dim as string FinalOutput
dim as string*8 OctaBits
for a as integer = 1 to len(Binary_Out) step 8
OctaBits = mid(Binary_Out,a,8)
mid(Binary_Out,a,8)="00000000"
Dec=0
if mid(OctaBits,1,1)="1" then Dec+=128
if mid(OctaBits,2,1)="1" then Dec+= 64
if mid(OctaBits,3,1)="1" then Dec+= 32
if mid(OctaBits,4,1)="1" then Dec+= 16
if mid(OctaBits,5,1)="1" then Dec+= 8
if mid(OctaBits,6,1)="1" then Dec+= 4
if mid(OctaBits,7,1)="1" then Dec+= 2
if mid(OctaBits,8,1)="1" then Dec+= 1
FinalOutput+=Chr(Dec)
next
FinalOutput = rtrim(FinalOutput,"_")
SetWindowText(EDIT_OUT,FinalOutput)
end if
end sub
'===============================================================================
'===============================================================================
sub GetKeys()
dim as string*1 CharSubKey
for a as integer = 1 to 2
for b as integer = 1 to 8
'print ((a*8)-8) +b-1
GetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , CharSubKey , 2)
SubKey( ((a*8)-8)+b-1 ) = asc(CharSubKey)
next
next
end sub
'===============================================================================
'===============================================================================
sub LoadKey()
GetFileName()
if fileexists(file) then
open file for input as #1
dim as String Inputs
line input #1 , Inputs
SetWindowText(MESSAGE_SIZE,Inputs)
Keys_Spinner_Val = val(inputs)
MessageSize()
line input #1 , Inputs
SetWindowText(GARBAGE_SIZE,Inputs)
Garbage_spinner_val = val(inputs)
GarbageSize()
Redim Key(0 to Keys_Spinner_val*8-1)
Redim SubKey(0 to 15)
dim as ulongint count
count=0
do
line input #1 , Inputs
Key(count) = val(Inputs)
count+=1
loop until count > ubound(Key)
count=0
do
line input #1 , Inputs
SubKey(count) = val(Inputs)
count+=1
loop until count = 16
Close #1
PrintKey()
dim as integer dec
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
Dec = (((y*8)-8)+x)-1
'print y,x,Dec,SubKey(Dec)
SetWindowText(EDIT_OUTS( Dec ) , chr(SubKey(Dec)) )
next
next
file=""
extension=""
end if
end sub
'===============================================================================
'===============================================================================
sub SaveKey()
getkeys()
GetFileName()
dim as string SaveKeys = ""
if file<>"" then
open file for output as #1
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
print #1 , textin
GetWindowText(GARBAGE_SIZE,textin,5)
print #1 , textin
for a as integer = lbound(key) to ubound(key)
print #1 , str(Key(a))
next
for a as integer = 0 to 15
Print #1 , SubKey(a)
next
close #1
end if
end sub
'===============================================================================
'===============================================================================
sub SaveOutput()
GetFileName()
if file<>"" then
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
open file for output as #1
print #1 , GetOutputMessage
close #1
end if
end sub
'===============================================================================
'===============================================================================
Sub CopyOutputToInput()
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
SetWindowText(EDIT_IN , GetOutputMessage)
SetWindowText(EDIT_OUT , "")
end sub
'===============================================================================
'===============================================================================
sub GenerateKey()
' ((a*64)-64)+((x*8)-8)+y
Redim Key(0 to (TabPages*64-1) )
dim a as integer
dim b as integer
dim c as integer
dim d as integer
'create random key for main cypher.
for a = 0 to (TabPages*64)-1
key(a) = 0
next
a=0
do
b = int(rnd*GarbageBits)+1
randomize b / sin(rnd*timer) / tan(timer/1000)
do
b = int(rnd*GarbageBits)+1
d = 0
for c = 0 to a
if key(c) = b then d = 1
next
loop until d = 0
key(a) = b
a = a + 1
loop until a=(TabPages*64)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GenerateSubKey()
Redim SubKey(0 to 15)
'create 16 letter subsitution for output
dim a as integer
dim b as integer
dim c as integer
dim d as integer
for a = 0 to 15
SubKey(a) = 0
next
a=0
do
b = int( rnd*26 )+65
do
b = int( rnd*26 )+65
d = 0
for c=0 to a
if SubKey(c) = b then d = 1
next
loop until d = 0
SubKey(a) = b
a=a+1
loop until a=16
'answer = ((a*8)-8) +b
for a = 1 to 2
for b = 1 to 8
'print ((a*8)-8) +b-1
SetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , chr( SubKey( ((a*8)-8)+b-1 ) ) )
next
next
end sub
'===============================================================================
'===============================================================================
sub getfilename()
dim ofn as OPENFILENAME
dim filename as zstring * MAX_PATH+1
with ofn
.lStructSize = sizeof( OPENFILENAME )
.hwndOwner = hWnd
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = strptr( !"All Files, (*.*)\0*.*\0\0" )
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = 1
.lpstrFile = @filename
.nMaxFile = sizeof( filename )
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = NULL
.lpstrTitle = @"File To Open."
.Flags = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
end with
if( GetOpenFileName( @ofn ) = FALSE ) then
file = ""
extension=""
return
else
file = filename
extension = right$(filename,4)
end if
end sub
Re: Slider Ctrl
@Dodicat
I figured it out , how to set the trackbar position...
This is the final output,... its flawless now...
I figured it out , how to set the trackbar position...
This is the final output,... its flawless now...
Code: Select all
'VariCyph FreeBasic Version 12.0
'
'Written by Albert Redditt
'
'albert_redditt@yahoo.com
#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"
#Include once "file.bi"
'===============================================================================
'===============================================================================
'Private function fb_Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
' Dim As HDC hDC=GetDC(HWND_DESKTOP)
' Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
' ReleaseDC(HWND_DESKTOP,hDC)
' Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,OEM_CHARSET _
' ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
'End Function
'Dim As HFONT fonthdl
'Dim As String fontname
'Dim As Integer fontsize = 8
'fontname = "FixedSys" ' "Courier new"
'fonthdl = fb_Set_Font(fontname,fontsize,TRUE,0,0,0)
'===============================================================================
'===============================================================================
Dim Shared As Long trackpos1 , getlast1
Dim Shared As Long trackpos2 , getlast2
'===============================================================================
'===============================================================================
Dim shared as integer TabPages : TabPages = 1
Dim Shared as integer GarbageBits : GarbageBits = 64
Dim Shared as integer GarbageBytes: GarbageBytes = 1
'===============================================================================
'===============================================================================
const Keys_Spinner_Val_max = 1024
const Keys_Spinner_val_min = 8
const Keys_Spinner_val_inc = 8
dim shared as uinteger Keys_Spinner_val = 8
const Garbage_Spinner_Val_max = 128
const Garbage_Spinner_val_min = 1
const Garbage_Spinner_val_inc = 1
dim shared as uinteger Garbage_Spinner_val = 1
'===============================================================================
'===============================================================================
dim shared as string file , extension , FileData
Redim shared as integer Key(0 to (64*TabPages)-1)
Redim shared as Ubyte SubKey(0 to 15)
for a as longint = lbound(key) to ubound(key)
key(a) = a
next
Declare sub PrintKey()
Declare sub LoadCypheredText()
Declare sub Cypher()
Declare sub DeCypher()
Declare sub GetKeys()
Declare sub LoadKey()
Declare sub SaveKey()
Declare sub SaveOutput()
Declare sub GenerateKey()
Declare sub GenerateSubKey()
Declare sub CopyOutputToInput()
Declare sub MessageSpinner_Up()
Declare sub MessageSpinner_Dn()
Declare sub MessageSize()
Declare sub GarbageSpinner_Up()
Declare sub GarbageSpinner_Dn()
Declare sub GarbageSize()
Declare sub GetFileName()
ReDim shared as hwnd STATICS(1 to TabPages)
ReDim shared as hwnd EDIT_KEY(1 to TabPages,1 to 8,1 to 8)
Dim shared as string Help_Text
Help_Text = "This encoder is a bit scrambler. (It can only load ASCII text files 8 bit.)" + chr(13) + chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "It scrambles message bytes amongst several times as many garbage bytes." + chr(13) + chr(10)
Help_Text+= "You select the number of message bytes. in multiples of 8" + chr(13) + chr(10)
Help_Text+= "Then" + chr(13) + chr(10)
Help_Text+= "You select the number of garbage bytes as a multiple of message bytes 1x , 2x , 4x etc.." + chr(13) + chr(10)
Help_Text+= "If garbage is set to 4 then the output will be 4 times as long as the message bytes." + chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "If message bytes is set to 16 then the message is broken into chunks of 16 bytes." + chr(13) + chr(10)
Help_Text+= "Message blocks can be any multiple of 8 , up to 1024."+chr(13)+chr(10)
Help_Text+= "Garbage blocks can be any multiple of MessageBlocks up to 128."+chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "Written in FreeBasic for Windows , by albert_redditt@yahoo.com"
Dim shared As MSG msg ' Message variable (stores massages)
Dim shared As HWND hWnd _
, EDIT_IN _
, EDITKEY _
, STATIC_OUTS(0 to 15) _
, EDIT_OUTS(0 to 15) _
, EDIT_OUT _
, LOADCYPHTEXT_BTN _
, CYPHER_BTN _
, DECYPHER_BTN _
, LOADKEY_BTN _
, SAVEKEY_BTN _
, GENERATEKEY_BTN _
, label1 _
, MESSAGE_SIZE _
, label2 _
, GARBAGE_SIZE _
, HELP _
, GENERATESUBKEY_BTN _
, SAVEOUTPUT_BTN _
, COPY_OUTPUT_TO_INPUT _ 'for multiple cyphering.
, TrackBar1 _
,TrackBar2
'===============================================================================
' Create window
hWnd = CreateWindowEx( 0, "#32770", "Vari_Cyph_FB_V12 Feb / 2017", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 600, 600, 0, 0, 0, 0 )
'create in edit
EDIT_IN = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL , 10, 10,430,110, hWnd, 0, 0, 0 )
'SendMessage(EDIT_IN,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create readonly edit out
EDIT_OUT = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,430,430,130, hWnd, 0, 0, 0 )
'SendMessage(EDIT_OUT,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create key edit
EDITKEY = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,125,430,215, hWnd, 0, 0, 0 )
'create labels and edits for output.
dim as integer count1
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
count1 = ((y*8)-8)+x-1
SubKey(count1)=(65+count1)
STATIC_OUTS(count1) = CreateWindowEx( 0,"STATIC", right("0000" + bin(count1),4), WS_VISIBLE Or WS_CHILD ,(x*38)-38+(15*x) ,280+( (y*12)+20+(32*y)) , 38, 20, hWnd, 0, 0, 0 )
EDIT_OUTS( count1 ) = CreateWindowEx( 0,"EDIT" , CHR(SubKey(count1)) , WS_VISIBLE Or WS_CHILD Or WS_BORDER,(x*38)-30+(15*x) ,305+( (y*12)+10+(32*y)) , 18, 20, hWnd, 0, 0, 0 )
next
next
LOADCYPHTEXT_BTN = CreateWindowEx( 0,"BUTTON" , "Load Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,10 , 100, 25, hWnd, 0, 0, 0 )
CYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,50 , 100, 25, hWnd, 0, 0, 0 )
DECYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "DeCypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,90 , 100, 25, hWnd, 0, 0, 0 )
LOADKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Load Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,130 , 100, 25, hWnd, 0, 0, 0 )
SAVEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Save Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,160 , 100, 25, hWnd, 0, 0, 0 )
GENERATEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Generate Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,190 , 100, 25, hWnd, 0, 0, 0 )
label1 = CreateWindowEx( 0,"STATIC" , "Message Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,225 , 100, 20, hWnd, 0, 0, 0 )
MESSAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(TabPages*8) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,245 , 100, 25, hWnd, 0, 0, 0 )
TrackBar1 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 270,120, 35, hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(1,1024\8))'TRACKBAR 1 to 128
label2 = CreateWindowEx( 0,"STATIC" , "Garbage Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,310 , 100, 20, hWnd, 0, 0, 0 )
GARBAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(GarbageBytes) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,330 , 100, 25, hWnd, 0, 0, 0 )
TrackBar2 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 355,120, 35, hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(1,128))'TRACKBAR 1 to 128
GENERATESUBKEY_BTN= CreateWindowEx( 0,"BUTTON" ,"Generate SubKey", WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,395 , 130, 25, hWnd, 0, 0, 0 )
SAVEOUTPUT_BTN = CreateWindowEx( 0,"BUTTON" , "Save Output" , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,435 , 130, 25, hWnd, 0, 0, 0 )
COPY_OUTPUT_TO_INPUT = CreateWindowEx( 0,"BUTTON" , "Copy to Input", WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,480 , 130, 25, hWnd, 0, 0, 0 )
HELP = CreateWindowEx( 0,"BUTTON" , "Help" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,525 , 130, 25, hWnd, 0, 0, 0 )
'End Control setup
PrintKey()
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
dim as WPARAM wparam
dim as LPARAM lparam
TranslateMessage( @msg )
DispatchMessage( @msg )
Select Case msg.hwnd
Case hWnd
Select Case msg.message
Case 273
PostQuitMessage(0)
'End
End Select
case TrackBar2
Select Case msg.message
case WM_MOUSEMOVE
trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0)
if trackpos1 <> getlast1 then
setwindowtext(GARBAGE_SIZE,Str(trackpos1))
GarbageSize()
end if
getlast1 = trackpos1
End Select
case TrackBar2
Select Case msg.message
case WM_MOUSEMOVE
trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
if trackpos2 <> getlast2 then
setwindowtext(GARBAGE_SIZE,Str(trackpos2))
GarbageSize()
end if
getlast2 = trackpos2
End Select
Case LOADCYPHTEXT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadCypheredText()
End Select
Case CYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
Cypher()
End Select
Case DECYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
DeCypher()
End Select
Case LOADKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadKey()
End Select
Case SAVEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveKey()
End Select
Case HELP
select case msg.message
case WM_LBUTTONDOWN
MessageBox(0,Help_Text,"Help",MB_OK)
end select
Case SAVEOUTPUT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveOutput()
End Select
Case COPY_OUTPUT_TO_INPUT
select Case msg.message
case WM_LBUTTONDOWN
CopyOutputToInput()
end select
Case GENERATEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateKey()
End Select
Case GENERATESUBKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateSubKey()
End Select
End Select
Wend
PostQuitMessage(0)
END
'===============================================================================
'===============================================================================
'subs and functions below here
'===============================================================================
'===============================================================================
sub MessageSize()
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Keys_Spinner_val = val(textin)
if Keys_Spinner_val > Keys_Spinner_Val_max = 1024 then
Keys_Spinner_val = Keys_Spinner_val_max
end if
dim as string str1
dim as integer dec1
do
str1=str(Keys_Spinner_val/8)
dec1=instr(1,str1,".")
if dec1<>0 then Keys_Spinner_val+=1
loop until dec1 = 0
SetWindowText(MESSAGE_SIZE,str(Keys_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GarbageSize()
dim as string*6 textin
GetWindowText(GARBAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Garbage_Spinner_val = val(textin)
if Garbage_Spinner_val > Garbage_Spinner_val_max then
Garbage_Spinner_val = Garbage_Spinner_val_max
end if
SetWindowText(GARBAGE_SIZE,str(Garbage_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub PrintKey()
dim as string KeyText
dim as longint count = 1
for a as longint = lbound(key) to ubound(Key)
if a mod 8 = 0 then KeyText+=right("____" + str(count),4)+")"
KeyText+=right("________"+str(key(a)),8)
if a mod 8 = 7 then KeyText +=chr(13)+chr(10) : count+=1
next
SETWINDOWTEXT( EDITKEY , KeyText)
end sub
'===============================================================================
'===============================================================================
sub LoadCypheredText()
'can only load ascii text files
GetFileName()
FileData=""
if fileexists(file) then
dim as string char
open file for input as #1
do
line input #1 , char
FileData = fileData + (char) + chr(13) + chr(10)
loop until EOF(1)
close #1
FileData = left(FileData,len(FileData)-2)
SetWindowText(EDIT_In,FileData)
FileData=""
file=""
end if
end sub
'===============================================================================
'===============================================================================
sub Cypher()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,Chr(32))
GetInputMessage = trim(GetInputMessage,chr(0))
'make input string an even number of Block sizes
dim as string str1
dim as single dec
do
str1=str( len(GetInputMessage) / (TabPages*8) )
dec=instr(1,str1,".")
if dec<>0 then GetInputMessage+="_" 'if message is not a multiple of (TabPages*8) characters
loop until dec=0
'turn message into binary
dim as string BinaryMessageBlocks
for a as integer = 1 to len(GetInputMessage) step 1
BinaryMessageBlocks+= right("00000000" + bin( asc(mid(GetInputMessage,a,1)) ) ,8)
next
'stick user message bits (TabPages*64/TabPages) into random garbage of length GarbageBits
dim as string MessageBits
dim as string RandomGarbage
dim as string Accumulated
dim as string mytext = ""
SetWindowText( CYPHER_BTN , "Cyphering.." )
sleep 1000
for a as integer = 1 to len(BinaryMessageBlocks) step (64*TabPages)
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
MessageBits = mid(BinaryMessageBlocks,a, 64*tabPages)
RandomGarbage=""
for garbage as integer = 1 to GarbageBits step 8
randomize
RandomGarbage+=right("00000000" + bin(int(rnd*256)) , 8)
next
for insert as integer = lbound(Key) to ubound(Key)
mid(RandomGarbage,Key(insert),1) = mid(MessageBits,insert+1,1)
next
Accumulated+=RandomGarbage
next
dim as string CypheredOutput=""
dim as string*4 QuadBits
dim as ubyte value
dim as longint count = 0
mytext=""
SetWindowText( CYPHER_BTN , "Create Output" )
sleep 1000
for a as integer = 1 to len(Accumulated) step 4
count+=1
if count = 100000 then
count = 0
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
end if
value=0
QuadBits=mid(Accumulated,a,4)
value = val("&B" + QuadBits)
CypheredOutput+=Chr(SubKey(value))
next
SetWindowText(EDIT_OUT,CypheredOutput)
CypheredOutput=""
SetWindowText( CYPHER_BTN , "Cypher")
end sub
'===============================================================================
'===============================================================================
sub DeCypher()
GetKeys()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,chr(0))
if len(GetInputMessage)<>0 then
dim as string BinarySubOutput(1 to (len(GetInputMessage)/(GarbageBits/8)/2) )
dim as string Bites
dim as integer Chunks = (len(GetInputMessage)/(GarbageBits/8)/2)
dim as ubyte Char
Dim as integer Dec=1
for a as integer = 1 to len(GetInputMessage) step (len(GetInputMessage)/Chunks)
Bites = mid( GetInputMessage, a, len(GetInputMessage)/Chunks )
for b as integer = 1 to len(bites)
Char = asc( mid(Bites,b,1) )
for c as integer = 0 to 15
if Char = SubKey(c) then BinarySubOutput(Dec)+=right("0000"+bin(c),4)
next
next
Dec+=1
next
Dec-=1
dim as string Binary_out
for a as integer = 1 to Dec step 1
for b as integer = 0 to ubound(Key)
Binary_Out+= mid(BinarySubOutput(a),Key(b),1)
next
next
dim as string FinalOutput
dim as string*8 OctaBits
for a as integer = 1 to len(Binary_Out) step 8
OctaBits = mid(Binary_Out,a,8)
mid(Binary_Out,a,8)="00000000"
Dec=0
if mid(OctaBits,1,1)="1" then Dec+=128
if mid(OctaBits,2,1)="1" then Dec+= 64
if mid(OctaBits,3,1)="1" then Dec+= 32
if mid(OctaBits,4,1)="1" then Dec+= 16
if mid(OctaBits,5,1)="1" then Dec+= 8
if mid(OctaBits,6,1)="1" then Dec+= 4
if mid(OctaBits,7,1)="1" then Dec+= 2
if mid(OctaBits,8,1)="1" then Dec+= 1
FinalOutput+=Chr(Dec)
next
FinalOutput = rtrim(FinalOutput,"_")
SetWindowText(EDIT_OUT,FinalOutput)
end if
end sub
'===============================================================================
'===============================================================================
sub GetKeys()
dim as string*1 CharSubKey
for a as integer = 1 to 2
for b as integer = 1 to 8
'print ((a*8)-8) +b-1
GetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , CharSubKey , 2)
SubKey( ((a*8)-8)+b-1 ) = asc(CharSubKey)
next
next
end sub
'===============================================================================
'===============================================================================
sub LoadKey()
GetFileName()
if fileexists(file) then
open file for input as #1
dim as String Inputs
line input #1 , Inputs
SetWindowText(MESSAGE_SIZE,Inputs)
Keys_Spinner_Val = val(inputs)
MessageSize()
SendMessage( TrackBar1 , TBM_SETPOS,1, val(inputs)\8)
getlast1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0)
line input #1 , Inputs
SetWindowText(GARBAGE_SIZE,Inputs)
Garbage_spinner_val = val(inputs)
GarbageSize()
SendMessage( TrackBar2 , TBM_SETPOS,1, val(inputs))
getlast2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
Redim Key(0 to Keys_Spinner_val*8-1)
Redim SubKey(0 to 15)
dim as ulongint count
count=0
do
line input #1 , Inputs
Key(count) = val(Inputs)
count+=1
loop until count > ubound(Key)
count=0
do
line input #1 , Inputs
SubKey(count) = val(Inputs)
count+=1
loop until count = 16
Close #1
PrintKey()
dim as integer dec
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
Dec = (((y*8)-8)+x)-1
'print y,x,Dec,SubKey(Dec)
SetWindowText(EDIT_OUTS( Dec ) , chr(SubKey(Dec)) )
next
next
file=""
extension=""
end if
end sub
'===============================================================================
'===============================================================================
sub SaveKey()
getkeys()
GetFileName()
dim as string SaveKeys = ""
if file<>"" then
open file for output as #1
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
print #1 , textin
GetWindowText(GARBAGE_SIZE,textin,5)
print #1 , textin
for a as integer = lbound(key) to ubound(key)
print #1 , str(Key(a))
next
for a as integer = 0 to 15
Print #1 , SubKey(a)
next
close #1
end if
end sub
'===============================================================================
'===============================================================================
sub SaveOutput()
GetFileName()
if file<>"" then
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
open file for output as #1
print #1 , GetOutputMessage
close #1
end if
end sub
'===============================================================================
'===============================================================================
Sub CopyOutputToInput()
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
SetWindowText(EDIT_IN , GetOutputMessage)
SetWindowText(EDIT_OUT , "")
end sub
'===============================================================================
'===============================================================================
sub GenerateKey()
' ((a*64)-64)+((x*8)-8)+y
Redim Key(0 to (TabPages*64-1) )
dim a as integer
dim b as integer
dim c as integer
dim d as integer
'create random key for main cypher.
for a = 0 to (TabPages*64)-1
key(a) = 0
next
a=0
do
b = int(rnd*GarbageBits)+1
randomize b / sin(rnd*timer) / tan(timer/1000)
do
b = int(rnd*GarbageBits)+1
d = 0
for c = 0 to a
if key(c) = b then d = 1
next
loop until d = 0
key(a) = b
a = a + 1
loop until a=(TabPages*64)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GenerateSubKey()
Redim SubKey(0 to 15)
'create 16 letter subsitution for output
dim a as integer
dim b as integer
dim c as integer
dim d as integer
for a = 0 to 15
SubKey(a) = 0
next
a=0
do
b = int( rnd*26 )+65
do
b = int( rnd*26 )+65
d = 0
for c=0 to a
if SubKey(c) = b then d = 1
next
loop until d = 0
SubKey(a) = b
a=a+1
loop until a=16
'answer = ((a*8)-8) +b
for a = 1 to 2
for b = 1 to 8
'print ((a*8)-8) +b-1
SetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , chr( SubKey( ((a*8)-8)+b-1 ) ) )
next
next
end sub
'===============================================================================
'===============================================================================
sub getfilename()
dim ofn as OPENFILENAME
dim filename as zstring * MAX_PATH+1
with ofn
.lStructSize = sizeof( OPENFILENAME )
.hwndOwner = hWnd
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = strptr( !"All Files, (*.*)\0*.*\0\0" )
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = 1
.lpstrFile = @filename
.nMaxFile = sizeof( filename )
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = NULL
.lpstrTitle = @"File To Open."
.Flags = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
end with
if( GetOpenFileName( @ofn ) = FALSE ) then
file = ""
extension=""
return
else
file = filename
extension = right$(filename,4)
end if
end sub
Re: Slider Ctrl
The Above had coding errors....
Here's the corrected code.. Its also on the "Projects" page of the forum..
Here's the corrected code.. Its also on the "Projects" page of the forum..
Code: Select all
'VariCyph FreeBasic Version 12.0
'
'Written by Albert Redditt
'
'albert_redditt@yahoo.com
#define WIN_INCLUDEALL
#Include once "windows.bi"
#Include once "/win/commctrl.bi"
#Include once "file.bi"
'===============================================================================
'===============================================================================
'Private function fb_Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
' Dim As HDC hDC=GetDC(HWND_DESKTOP)
' Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
' ReleaseDC(HWND_DESKTOP,hDC)
' Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,OEM_CHARSET _
' ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
'End Function
'Dim As HFONT fonthdl
'Dim As String fontname
'Dim As Integer fontsize = 8
'fontname = "FixedSys" ' "Courier new"
'fonthdl = fb_Set_Font(fontname,fontsize,TRUE,0,0,0)
'===============================================================================
'===============================================================================
Dim Shared As Long trackpos1 , getlast1=1
Dim Shared As Long trackpos2 , getlast2=1
'===============================================================================
'===============================================================================
Dim shared as integer TabPages : TabPages = 1
Dim Shared as integer GarbageBits : GarbageBits = 64
Dim Shared as integer GarbageBytes: GarbageBytes = 1
'===============================================================================
'===============================================================================
const Keys_Spinner_Val_max = 1024
const Keys_Spinner_val_min = 8
const Keys_Spinner_val_inc = 8
dim shared as uinteger Keys_Spinner_val = 8
const Garbage_Spinner_Val_max = 128
const Garbage_Spinner_val_min = 1
const Garbage_Spinner_val_inc = 1
dim shared as uinteger Garbage_Spinner_val = 1
'===============================================================================
'===============================================================================
dim shared as string file , extension , FileData
Redim shared as integer Key(0 to (64*TabPages)-1)
Redim shared as Ubyte SubKey(0 to 15)
for a as longint = lbound(key) to ubound(key)
key(a) = a
next
Declare sub PrintKey()
Declare sub LoadCypheredText()
Declare sub Cypher()
Declare sub DeCypher()
Declare sub GetKeys()
Declare sub LoadKey()
Declare sub SaveKey()
Declare sub SaveOutput()
Declare sub GenerateKey()
Declare sub GenerateSubKey()
Declare sub CopyOutputToInput()
Declare sub MessageSpinner_Up()
Declare sub MessageSpinner_Dn()
Declare sub MessageSize()
Declare sub GarbageSpinner_Up()
Declare sub GarbageSpinner_Dn()
Declare sub GarbageSize()
Declare sub GetFileName()
ReDim shared as hwnd STATICS(1 to TabPages)
ReDim shared as hwnd EDIT_KEY(1 to TabPages,1 to 8,1 to 8)
Dim shared as string Help_Text
Help_Text = "This encoder is a bit scrambler. (It can only load ASCII text files 8 bit.)" + chr(13) + chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "It scrambles message bytes amongst several times as many garbage bytes." + chr(13) + chr(10)
Help_Text+= "You select the number of message bytes. in multiples of 8" + chr(13) + chr(10)
Help_Text+= "Then" + chr(13) + chr(10)
Help_Text+= "You select the number of garbage bytes as a multiple of message bytes 1x , 2x , 4x etc.." + chr(13) + chr(10)
Help_Text+= "If garbage is set to 4 then the output will be 4 times as long as the message bytes." + chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "If message bytes is set to 16 then the message is broken into chunks of 16 bytes." + chr(13) + chr(10)
Help_Text+= "Message blocks can be any multiple of 8 , up to 1024."+chr(13)+chr(10)
Help_Text+= "Garbage blocks can be any multiple of MessageBlocks up to 128."+chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= chr(13)+chr(10)
Help_Text+= "Written in FreeBasic for Windows , by albert_redditt@yahoo.com"
Dim shared As MSG msg ' Message variable (stores massages)
Dim shared As HWND hWnd _
, EDIT_IN _
, EDITKEY _
, STATIC_OUTS(0 to 15) _
, EDIT_OUTS(0 to 15) _
, EDIT_OUT _
, LOADCYPHTEXT_BTN _
, CYPHER_BTN _
, DECYPHER_BTN _
, LOADKEY_BTN _
, SAVEKEY_BTN _
, GENERATEKEY_BTN _
, label1 _
, MESSAGE_SIZE _
, label2 _
, GARBAGE_SIZE _
, HELP _
, GENERATESUBKEY_BTN _
, SAVEOUTPUT_BTN _
, COPY_OUTPUT_TO_INPUT _ 'for multiple cyphering.
, TrackBar1 _
,TrackBar2
'===============================================================================
' Create window
hWnd = CreateWindowEx( 0, "#32770", "Vari_Cyph_FB_V12 Feb / 2017", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 600, 600, 0, 0, 0, 0 )
'create in edit
EDIT_IN = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL , 10, 10,430,110, hWnd, 0, 0, 0 )
'SendMessage(EDIT_IN,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create readonly edit out
EDIT_OUT = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,430,430,130, hWnd, 0, 0, 0 )
'SendMessage(EDIT_OUT,WM_SETFONT,Cast(WPARAM,fonthdl),0)
'create key edit
EDITKEY = CreateWindowEx( 0, "EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER or ES_MULTILINE or WS_VSCROLL or WS_HSCROLL or ES_READONLY, 10,125,430,215, hWnd, 0, 0, 0 )
'create labels and edits for output.
dim as integer count1
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
count1 = ((y*8)-8)+x-1
SubKey(count1)=(65+count1)
STATIC_OUTS(count1) = CreateWindowEx( 0,"STATIC", right("0000" + bin(count1),4), WS_VISIBLE Or WS_CHILD ,(x*38)-38+(15*x) ,280+( (y*12)+20+(32*y)) , 38, 20, hWnd, 0, 0, 0 )
EDIT_OUTS( count1 ) = CreateWindowEx( 0,"EDIT" , CHR(SubKey(count1)) , WS_VISIBLE Or WS_CHILD Or WS_BORDER,(x*38)-30+(15*x) ,305+( (y*12)+10+(32*y)) , 18, 20, hWnd, 0, 0, 0 )
next
next
LOADCYPHTEXT_BTN = CreateWindowEx( 0,"BUTTON" , "Load Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,10 , 100, 25, hWnd, 0, 0, 0 )
CYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "Cypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,50 , 100, 25, hWnd, 0, 0, 0 )
DECYPHER_BTN = CreateWindowEx( 0,"BUTTON" , "DeCypher" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,90 , 100, 25, hWnd, 0, 0, 0 )
LOADKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Load Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,130 , 100, 25, hWnd, 0, 0, 0 )
SAVEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Save Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,160 , 100, 25, hWnd, 0, 0, 0 )
GENERATEKEY_BTN = CreateWindowEx( 0,"BUTTON" , "Generate Key" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,460 ,190 , 100, 25, hWnd, 0, 0, 0 )
label1 = CreateWindowEx( 0,"STATIC" , "Message Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,225 , 100, 20, hWnd, 0, 0, 0 )
MESSAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(TabPages*8) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,245 , 100, 25, hWnd, 0, 0, 0 )
TrackBar1 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 270,120, 35, hwnd,0,0,0)
SendMessage(TrackBar1, TBM_SETRANGE,TRUE, MAKELONG(1,1024\8))'TRACKBAR 1 to 128
label2 = CreateWindowEx( 0,"STATIC" , "Garbage Size" , WS_VISIBLE or WS_CHILD or WS_BORDER ,460 ,310 , 100, 20, hWnd, 0, 0, 0 )
GARBAGE_SIZE = CreateWindowEx( 0,"STATIC" , str(GarbageBytes) , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,460 ,330 , 100, 25, hWnd, 0, 0, 0 )
TrackBar2 = CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 450, 355,120, 35, hwnd,0,0,0)
SendMessage(TrackBar2, TBM_SETRANGE,TRUE, MAKELONG(1,128))'TRACKBAR 1 to 128
GENERATESUBKEY_BTN= CreateWindowEx( 0,"BUTTON" ,"Generate SubKey", WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,395 , 130, 25, hWnd, 0, 0, 0 )
SAVEOUTPUT_BTN = CreateWindowEx( 0,"BUTTON" , "Save Output" , WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,435 , 130, 25, hWnd, 0, 0, 0 )
COPY_OUTPUT_TO_INPUT = CreateWindowEx( 0,"BUTTON" , "Copy to Input", WS_VISIBLE Or WS_CHILD Or WS_BORDER ,445 ,480 , 130, 25, hWnd, 0, 0, 0 )
HELP = CreateWindowEx( 0,"BUTTON" , "Help" , WS_VISIBLE Or WS_CHILD Or WS_BORDER,445 ,525 , 130, 25, hWnd, 0, 0, 0 )
'End Control setup
PrintKey()
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
'begin mesage processing
While GetMessage( @msg, 0, 0, 0 )
dim as WPARAM wparam
dim as LPARAM lparam
TranslateMessage( @msg )
DispatchMessage( @msg )
Select Case msg.hwnd
Case hWnd
Select Case msg.message
Case 273
PostQuitMessage(0)
'End
End Select
case TrackBar1
Select Case msg.message
case WM_MOUSEMOVE
trackpos1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0) *8
if trackpos1 <> getlast1 then
setwindowtext(MESSAGE_SIZE,Str(trackpos1))
MessageSize()
getlast1 = trackpos1
end if
End Select
case TrackBar2
Select Case msg.message
case WM_MOUSEMOVE
trackpos2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
if trackpos2 <> getlast2 then
setwindowtext(GARBAGE_SIZE,Str(trackpos2))
GarbageSize()
end if
getlast2 = trackpos2
End Select
Case LOADCYPHTEXT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadCypheredText()
End Select
Case CYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
Cypher()
End Select
Case DECYPHER_BTN
Select Case msg.message
case WM_LBUTTONDOWN
DeCypher()
End Select
Case LOADKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
LoadKey()
End Select
Case SAVEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveKey()
End Select
Case HELP
select case msg.message
case WM_LBUTTONDOWN
MessageBox(0,Help_Text,"Help",MB_OK)
end select
Case SAVEOUTPUT_BTN
Select Case msg.message
case WM_LBUTTONDOWN
SaveOutput()
End Select
Case COPY_OUTPUT_TO_INPUT
select Case msg.message
case WM_LBUTTONDOWN
CopyOutputToInput()
end select
Case GENERATEKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateKey()
End Select
Case GENERATESUBKEY_BTN
Select Case msg.message
case WM_LBUTTONDOWN
GenerateSubKey()
End Select
End Select
Wend
PostQuitMessage(0)
END
'===============================================================================
'===============================================================================
'subs and functions below here
'===============================================================================
'===============================================================================
sub MessageSize()
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Keys_Spinner_val = val(textin)
if Keys_Spinner_val > Keys_Spinner_Val_max = 1024 then
Keys_Spinner_val = Keys_Spinner_val_max
end if
dim as string str1
dim as integer dec1
do
str1=str(Keys_Spinner_val/8)
dec1=instr(1,str1,".")
if dec1<>0 then Keys_Spinner_val+=1
loop until dec1 = 0
SetWindowText(MESSAGE_SIZE,str(Keys_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GarbageSize()
dim as string*6 textin
GetWindowText(GARBAGE_SIZE,textin,5)
textin=trim(textin,chr(32))
textin=trim(textin,chr(0))
Garbage_Spinner_val = val(textin)
if Garbage_Spinner_val > Garbage_Spinner_val_max then
Garbage_Spinner_val = Garbage_Spinner_val_max
end if
SetWindowText(GARBAGE_SIZE,str(Garbage_Spinner_val))
TabPages = Keys_Spinner_val / 8
Garbagebits = Garbage_Spinner_Val*8*Keys_Spinner_Val
GarbageBytes = GarbageBits/8/Keys_Spinner_val
Redim as integer Key(0 to (64*TabPages)-1)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub PrintKey()
dim as string KeyText
dim as longint count = 1
for a as longint = lbound(key) to ubound(Key)
if a mod 8 = 0 then KeyText+=right("____" + str(count),4)+")"
KeyText+=right("________"+str(key(a)),8)
if a mod 8 = 7 then KeyText +=chr(13)+chr(10) : count+=1
next
SETWINDOWTEXT( EDITKEY , KeyText)
end sub
'===============================================================================
'===============================================================================
sub LoadCypheredText()
'can only load ascii text files
GetFileName()
FileData=""
if fileexists(file) then
dim as string char
open file for input as #1
do
line input #1 , char
FileData = fileData + (char) + chr(13) + chr(10)
loop until EOF(1)
close #1
FileData = left(FileData,len(FileData)-2)
SetWindowText(EDIT_In,FileData)
FileData=""
file=""
end if
end sub
'===============================================================================
'===============================================================================
sub Cypher()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,Chr(32))
GetInputMessage = trim(GetInputMessage,chr(0))
'make input string an even number of Block sizes
dim as string str1
dim as single dec
do
str1=str( len(GetInputMessage) / (TabPages*8) )
dec=instr(1,str1,".")
if dec<>0 then GetInputMessage+="_" 'if message is not a multiple of (TabPages*8) characters
loop until dec=0
'turn message into binary
dim as string BinaryMessageBlocks
for a as integer = 1 to len(GetInputMessage) step 1
BinaryMessageBlocks+= right("00000000" + bin( asc(mid(GetInputMessage,a,1)) ) ,8)
next
'stick user message bits (TabPages*64/TabPages) into random garbage of length GarbageBits
dim as string MessageBits
dim as string RandomGarbage
dim as string Accumulated
dim as string mytext = ""
SetWindowText( CYPHER_BTN , "Cyphering.." )
sleep 1000
for a as integer = 1 to len(BinaryMessageBlocks) step (64*TabPages)
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
MessageBits = mid(BinaryMessageBlocks,a, 64*tabPages)
RandomGarbage=""
for garbage as integer = 1 to GarbageBits step 8
randomize
RandomGarbage+=right("00000000" + bin(int(rnd*256)) , 8)
next
for insert as integer = lbound(Key) to ubound(Key)
mid(RandomGarbage,Key(insert),1) = mid(MessageBits,insert+1,1)
next
Accumulated+=RandomGarbage
next
dim as string CypheredOutput=""
dim as string*4 QuadBits
dim as ubyte value
dim as longint count = 0
mytext=""
SetWindowText( CYPHER_BTN , "Create Output" )
sleep 1000
for a as integer = 1 to len(Accumulated) step 4
count+=1
if count = 100000 then
count = 0
mytext+="."
if len(mytext) > 6 then mytext = ""
SetWindowText( CYPHER_BTN , mytext )
end if
value=0
QuadBits=mid(Accumulated,a,4)
value = val("&B" + QuadBits)
CypheredOutput+=Chr(SubKey(value))
next
SetWindowText(EDIT_OUT,CypheredOutput)
CypheredOutput=""
SetWindowText( CYPHER_BTN , "Cypher")
end sub
'===============================================================================
'===============================================================================
sub DeCypher()
GetKeys()
'get message input from input edit_box into a string
dim as string GetInputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_IN)+1)
GetInputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_IN , GetInputMessage, txtlen)
GetInputMessage = trim(GetInputMessage,chr(0))
if len(GetInputMessage)<>0 then
dim as string BinarySubOutput(1 to (len(GetInputMessage)/(GarbageBits/8)/2) )
dim as string Bites
dim as integer Chunks = (len(GetInputMessage)/(GarbageBits/8)/2)
dim as ubyte Char
Dim as integer Dec=1
for a as integer = 1 to len(GetInputMessage) step (len(GetInputMessage)/Chunks)
Bites = mid( GetInputMessage, a, len(GetInputMessage)/Chunks )
for b as integer = 1 to len(bites)
Char = asc( mid(Bites,b,1) )
for c as integer = 0 to 15
if Char = SubKey(c) then BinarySubOutput(Dec)+=right("0000"+bin(c),4)
next
next
Dec+=1
next
Dec-=1
dim as string Binary_out
for a as integer = 1 to Dec step 1
for b as integer = 0 to ubound(Key)
Binary_Out+= mid(BinarySubOutput(a),Key(b),1)
next
next
dim as string FinalOutput
dim as string*8 OctaBits
for a as integer = 1 to len(Binary_Out) step 8
OctaBits = mid(Binary_Out,a,8)
mid(Binary_Out,a,8)="00000000"
Dec=0
if mid(OctaBits,1,1)="1" then Dec+=128
if mid(OctaBits,2,1)="1" then Dec+= 64
if mid(OctaBits,3,1)="1" then Dec+= 32
if mid(OctaBits,4,1)="1" then Dec+= 16
if mid(OctaBits,5,1)="1" then Dec+= 8
if mid(OctaBits,6,1)="1" then Dec+= 4
if mid(OctaBits,7,1)="1" then Dec+= 2
if mid(OctaBits,8,1)="1" then Dec+= 1
FinalOutput+=Chr(Dec)
next
FinalOutput = rtrim(FinalOutput,"_")
SetWindowText(EDIT_OUT,FinalOutput)
end if
end sub
'===============================================================================
'===============================================================================
sub GetKeys()
dim as string*1 CharSubKey
for a as integer = 1 to 2
for b as integer = 1 to 8
'print ((a*8)-8) +b-1
GetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , CharSubKey , 2)
SubKey( ((a*8)-8)+b-1 ) = asc(CharSubKey)
next
next
end sub
'===============================================================================
'===============================================================================
sub LoadKey()
GetFileName()
if fileexists(file) then
open file for input as #1
dim as String Inputs
line input #1 , Inputs
SetWindowText(MESSAGE_SIZE,Inputs)
Keys_Spinner_Val = val(inputs)
MessageSize()
SendMessage( TrackBar1 , TBM_SETPOS,1, val(inputs)\8)
getlast1 = SendMessage(TrackBar1, TBM_GETPOS, 0, 0) *8
line input #1 , Inputs
SetWindowText(GARBAGE_SIZE,Inputs)
Garbage_spinner_val = val(inputs)
GarbageSize()
SendMessage( TrackBar2 , TBM_SETPOS,1, val(inputs))
getlast2 = SendMessage(TrackBar2, TBM_GETPOS, 0, 0)
Redim Key(0 to Keys_Spinner_val*8-1)
Redim SubKey(0 to 15)
dim as ulongint count
count=0
do
line input #1 , Inputs
Key(count) = val(Inputs)
count+=1
loop until count > ubound(Key)
count=0
do
line input #1 , Inputs
SubKey(count) = val(Inputs)
count+=1
loop until count = 16
Close #1
PrintKey()
dim as integer dec
for y as integer = 1 to 2 step 1
for x as integer = 1 to 8 step 1
Dec = (((y*8)-8)+x)-1
'print y,x,Dec,SubKey(Dec)
SetWindowText(EDIT_OUTS( Dec ) , chr(SubKey(Dec)) )
next
next
file=""
extension=""
end if
end sub
'===============================================================================
'===============================================================================
sub SaveKey()
getkeys()
GetFileName()
dim as string SaveKeys = ""
if file<>"" then
open file for output as #1
dim as string*6 textin
GetWindowText(MESSAGE_SIZE,textin,5)
print #1 , textin
GetWindowText(GARBAGE_SIZE,textin,5)
print #1 , textin
for a as integer = lbound(key) to ubound(key)
print #1 , str(Key(a))
next
for a as integer = 0 to 15
Print #1 , SubKey(a)
next
close #1
end if
end sub
'===============================================================================
'===============================================================================
sub SaveOutput()
GetFileName()
if file<>"" then
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
open file for output as #1
print #1 , GetOutputMessage
close #1
end if
end sub
'===============================================================================
'===============================================================================
Sub CopyOutputToInput()
'get message input from Output edit_box into a string
dim as string GetOutputMessage
dim as integer txtlen
txtlen = (GetWindowTextLength(EDIT_OUT)+1)
GetOutputMessage = string(txtlen,chr(0))
GetWindowText(EDIT_OUT , GetOutputMessage, txtlen)
GetOutputMessage = trim(GetOutputMessage,chr(0))
SetWindowText(EDIT_IN , GetOutputMessage)
SetWindowText(EDIT_OUT , "")
end sub
'===============================================================================
'===============================================================================
sub GenerateKey()
' ((a*64)-64)+((x*8)-8)+y
Redim Key(0 to (TabPages*64-1) )
dim a as integer
dim b as integer
dim c as integer
dim d as integer
'create random key for main cypher.
for a = 0 to (TabPages*64)-1
key(a) = 0
next
a=0
do
b = int(rnd*GarbageBits)+1
randomize b / sin(rnd*timer) / tan(timer/1000)
do
b = int(rnd*GarbageBits)+1
d = 0
for c = 0 to a
if key(c) = b then d = 1
next
loop until d = 0
key(a) = b
a = a + 1
loop until a=(TabPages*64)
PrintKey()
end sub
'===============================================================================
'===============================================================================
sub GenerateSubKey()
Redim SubKey(0 to 15)
'create 16 letter subsitution for output
dim a as integer
dim b as integer
dim c as integer
dim d as integer
for a = 0 to 15
SubKey(a) = 0
next
a=0
do
b = int( rnd*26 )+65
do
b = int( rnd*26 )+65
d = 0
for c=0 to a
if SubKey(c) = b then d = 1
next
loop until d = 0
SubKey(a) = b
a=a+1
loop until a=16
'answer = ((a*8)-8) +b
for a = 1 to 2
for b = 1 to 8
'print ((a*8)-8) +b-1
SetWindowText( EDIT_OUTS( ((a*8)-8)+b-1 ) , chr( SubKey( ((a*8)-8)+b-1 ) ) )
next
next
end sub
'===============================================================================
'===============================================================================
sub getfilename()
dim ofn as OPENFILENAME
dim filename as zstring * MAX_PATH+1
with ofn
.lStructSize = sizeof( OPENFILENAME )
.hwndOwner = hWnd
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = strptr( !"All Files, (*.*)\0*.*\0\0" )
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = 1
.lpstrFile = @filename
.nMaxFile = sizeof( filename )
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = NULL
.lpstrTitle = @"File To Open."
.Flags = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
end with
if( GetOpenFileName( @ofn ) = FALSE ) then
file = ""
extension=""
return
else
file = filename
extension = right$(filename,4)
end if
end sub