Small Crypt Demonstration for Files & Text

Technical support and scripting issues

Moderators: Dorian (MJT support), JRL

Post Reply
olllllliii
Pro Scripter
Posts: 60
Joined: Tue Dec 22, 2009 9:51 am
Location: Mannheim ( Germany )
Contact:

Small Crypt Demonstration for Files & Text

Post by olllllliii » Tue Jan 31, 2012 4:36 pm

A small Program that demonstrates crypt :-)
Have fun

Code: Select all

Let>APP_TITLE={"Crypt Demonstration"}
RegistryReadKey>HKEY_LOCAL_MACHINE,Software\Microsoft\Windows\CurrentVersion,ProgramFilesDir,strProgDir
Let>DESK=DESKTOP_DIR
Let>PROGDIR=strProgDir
Let>MSG_STAYONTOP=1
Let>MSG_CENTERED=1
Let>MSG_WIDTH=500
Let>Null=
Let>zuzu=CRLF

IfDirExists>%PROGDIR%\CRYPT,esistda2,esistweg2
Label>esistweg2
CreateDir>%PROGDIR%\CRYPT
Label>esistda2

IfFileExists>%PROGDIR%\CRYPT\pass.last,joisda,noenedda
Label>noenedda
WriteLn>%PROGDIR%\CRYPT\pass.last,yes,AFFEAFFE
Label>joisda
ReadLn>%PROGDIR%\CRYPT\pass.last,1,strLinePass
Let>KEY=strLinePass

IfDirExists>%DESK%\CRYPT,esistda,esistweg
Label>esistweg
CreateDir>%desk%\CRYPT
Label>esistda

Dialog>Dialog1
object Dialog1: TForm
  Left = 247
  Top = 119
  HelpContext = 5000
  BorderIcons = [biSystemMenu]
  BorderStyle = bsSingle
  Caption = 'SMALL CRYPT DEMONSTRATION BY OLI'
  ClientHeight = 215
  ClientWidth = 256
  Color = clBlack
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu
  OldCreateOrder = True
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 216
    Width = 112
    Height = 16
    Caption = 'Trial Version for'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWhite
    Font.Height = -13
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label2: TLabel
    Left = 128
    Top = 216
    Width = 57
    Height = 16
    Caption = '30 Days'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWhite
    Font.Height = -13
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label3: TLabel
    Left = 8
    Top = 240
    Width = 177
    Height = 16
    Caption = 'HOCK O.Hilger Mannheim'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWhite
    Font.Height = -13
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object msButton1: tMSButton
    Left = 94
    Top = 5
    Width = 75
    Height = 41
    Caption = 'CRYPT File'
    ModalResult = 1
    ParentShowHint = False
    ShowHint = False
    TabOrder = 8
    DoBrowse = False
    BrowseStyle = fbOpen
  end
  object msButton2: tMSButton
    Left = 6
    Top = 5
    Width = 83
    Height = 41
    Caption = 'DECRYPT File'
    ModalResult = 3
    ParentShowHint = False
    ShowHint = False
    TabOrder = 0
    DoBrowse = False
    BrowseStyle = fbOpen
  end
  object msButton3: tMSButton
    Left = 174
    Top = 5
    Width = 75
    Height = 41
    Caption = 'EXIT'
    ModalResult = 2
    ParentShowHint = False
    ShowHint = False
    TabOrder = 1
    DoBrowse = False
    BrowseStyle = fbOpen
  end
  object Edit1: TEdit
    Left = 8
    Top = 50
    Width = 153
    Height = 21
    Color = clSilver
    PasswordChar = '"'
    TabOrder = 2
    Text = 'AFFEAFFE'
  end
  object MSButton4: tMSButton
    Left = 166
    Top = 48
    Width = 83
    Height = 25
    Caption = 'SET PASS'
    TabOrder = 3
    DoBrowse = False
    BrowseStyle = fbOpen
  end
  object MSButton5: tMSButton
    Left = 8
    Top = 130
    Width = 81
    Height = 25
    Caption = 'Clear'
    TabOrder = 4
    DoBrowse = False
    BrowseStyle = fbOpen
  end
  object MSButton6: tMSButton
    Left = 91
    Top = 130
    Width = 158
    Height = 25
    Caption = 'CRYPT DECRYPT Text'
    TabOrder = 5
    DoBrowse = False
    BrowseStyle = fbOpen
  end
  object MSMemo1: tMSMemo
    Left = 8
    Top = 80
    Width = 241
    Height = 48
    Color = 16763605
    TabOrder = 6
  end
  object MSMemo2: tMSMemo
    Left = 8
    Top = 157
    Width = 241
    Height = 52
    Color = 16744576
    TabOrder = 7
  end
  object MSButton7: tMSButton
    Left = 192
    Top = 216
    Width = 49
    Height = 41
    Caption = 'GO'
    TabOrder = 9
    DoBrowse = False
    BrowseStyle = fbOpen
  end
  object MainMenu: tMSMainMenu
  end
end
EndDialog>Dialog1

Dialog>Dialog2
object Dialog2: TForm
  Left = 450
  Top = 148
  HelpContext = 5000
  BorderIcons = [biSystemMenu]
  Caption = 'Select your File'
  ClientHeight = 72
  ClientWidth = 449
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Position = poDesigned
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object Edit1: TEdit
    Left = 8
    Top = 9
    Width = 409
    Height = 21
    TabOrder = 0
  end
  object MSButton1: tMSButton
    Left = 421
    Top = 9
    Width = 21
    Height = 21
    DoubleBuffered = True
    Glyph.Data = {
      F6000000424DF600000000000000760000002800000010000000100000000100
      0400000000008000000000000000000000001000000010000000000000000000
      80000080000000808000800000008000800080800000C0C0C000808080000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
      77777777777777777777000000000007777700333333333077770B0333333333
      07770FB03333333330770BFB0333333333070FBFB000000000000BFBFBFBFB07
      77770FBFBFBFBF0777770BFB0000000777777000777777770007777777777777
      7007777777770777070777777777700077777777777777777777}
    ParentDoubleBuffered = False
    TabOrder = 1
    DoBrowse = False
    Filter = 'Any file (*.*)|*.*|CRYPT file (*.cry)|*.cry'
    BrowseStyle = fbOpen
  end
  object MSButton2: tMSButton
    Left = 7
    Top = 39
    Width = 434
    Height = 25
    Caption = 'OK'
    DoubleBuffered = True
    ModalResult = 2
    ParentDoubleBuffered = False
    TabOrder = 2
    DoBrowse = False
    BrowseStyle = fbOpen
  end
end
EndDialog>Dialog2

Dialog>Dialog5
object Dialog5: TForm
  Left = 350
  Top = 174
  HelpContext = 5000
  BorderIcons = [biSystemMenu]
  Caption = 'No Connection to Internet'
  ClientHeight = 242
  ClientWidth = 212
  Color = 14811134
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  ShowHint = True
  OnTaskBar = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label2: TLabel
    Left = 8
    Top = 8
    Width = 95
    Height = 20
    Caption = 'Buy via Mail'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label3: TLabel
    Left = 8
    Top = 64
    Width = 128
    Height = 20
    Caption = 'HOCK-Software'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label4: TLabel
    Left = 8
    Top = 88
    Width = 155
    Height = 20
    Caption = 'Fahrlachstrasse 16'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label1: TLabel
    Left = 8
    Top = 112
    Width = 138
    Height = 20
    Caption = '68165 Mannheim'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label5: TLabel
    Left = 8
    Top = 144
    Width = 73
    Height = 20
    Caption = 'Germany'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label6: TLabel
    Left = 8
    Top = 184
    Width = 201
    Height = 20
    Caption = 'Phone.: +496218619794'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label7: TLabel
    Left = 8
    Top = 208
    Width = 201
    Height = 20
    Caption = 'Shipping + CD 15 Euro'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
end
EndDialog>Dialog5

AddDialogHandler>Dialog2,MSButton1,OnClick,DoBrowse
AddDialogHandler>Dialog2,MSButton2,OnClick,DoCRYPT

SRT>DoCRYPT
  Let>datei=strFileName
END>DoCRYPT

SRT>DoBrowse
  SetDialogProperty>Dialog2,MSButton1,DoBrowse,True
  GetDialogProperty>Dialog2,MSButton1,Filename,strFileName
  SetDialogProperty>Dialog2,Edit1,Text,strFileName
END>DoBrowse

SetDialogProperty>Dialog1,Edit1,text,%KEY%
AddDialogHandler>Dialog1,MSButton1,OnClick,verschluesseln
AddDialogHandler>Dialog1,MSButton2,OnClick,entschluesseln
AddDialogHandler>Dialog1,MSButton3,OnClick,end
AddDialogHandler>Dialog1,MSButton4,OnClick,SetKey
AddDialogHandler>Dialog1,MSButton5,OnClick,ClearFields
AddDialogHandler>Dialog1,MSButton6,OnClick,Translate
AddDialogHandler>Dialog1,MenuItem2,OnClick,end
AddDialogHandler>Dialog1,MSButton7,OnClick,callHock
AddDialogHandler>Dialog1,,OnClose,end

Show>Dialog1,r

SRT>Translate
    SetDialogProperty>Dialog1,MSMemo2,text,Null
    GetDialogProperty>Dialog1,MSMemo1,text,dlgValue
    IF>dlgValue=
        WaitClipBoard
        GetClipBoard>info
        Let>dlgValue=info
    ENDIF
    Let>CRYPT_LEVEL=3
    Crypt>KEY,dlgValue,outdateiC
    Base64>outdateiC,ENCODE,strDataXC
    SetDialogProperty>Dialog1,MSMemo2,text,outDateiC
    WaitClipBoard
    PutClipBoard>outDateiC
END>Translate

SRT>ClearFields
      SetDialogProperty>Dialog1,MSMemo1,text,Null
      SetDialogProperty>Dialog1,MSMemo2,text,Null
END>ClearFields

SRT>end
    EXIT(0)
END>end
    
SRT>verschluesseln
    Show>Dialog2,r
    ExtractFileName>datei,strFileName
    ReadFile>datei,strFileContents
    Let>CRYPT_LEVEL=3
    Crypt>KEY,strFileContents,outdatei
    Base64>outdatei,ENCODE,strDataX
    Let>WLN_NOCRLF=1
    WriteLn>%desk%\CRYPT\%strFileName%.cry,nWLNRes,strDataX
    ExecuteFile>%desk%\CRYPT
END>verschluesseln

SRT>entschluesseln
    Show>Dialog2,r
    ExtractFileExt>datei,strExto
    ExtractFileName>datei,strFileNameo
    StringReplace>strFileNameo,strExto,,strNewStringo
    Let>WLN_NOCRLF=1
    ReadFile>datei,strData2
    Base64>strData2,DECODE,strData
    Let>CRYPT_LEVEL=3
    Crypt>KEY,strData,output
    WriteLn>%desk%\CRYPT\%strNewStringo%,nWLNRes,output
    ExecuteFile>%desk%\CRYPT
END>entschluesseln

SRT>SetKey
    GetDialogProperty>Dialog1,Edit1,text,dlgValue
    Let>KEY=%dlgValue%
    IF>KEY=
        MessageModal>Type in a password thats not empty :-)
    ENDIF
    DeleteFile>%PROGDIR%\CRYPT\pass.last
    WriteLn>%PROGDIR%\CRYPT\pass.last,yes,KEY
END>SetKey


Oliver Hilger Mannheim
alias Olllllliii

Post Reply
cron
Sign up to our newsletter for free automation tips, tricks & discounts