I made a little tool to store encrypted data.
Here is my source.
http://www.atzwanger-software.com/fw/codememo.zip
Best regards,
Otto
//------------------------
Func ENCRYPT( TO_DO )
LOCAL PADBACK := LEN(TO_DO), DONE := " ", QAZ
TO_DO := ALLTRIM(TO_DO)
FOR QAZ = LEN(TO_DO) TO 1 STEP -1
DONE := DONE + CHR(ASC(SUBSTR(TO_DO, QAZ, 1)) + 104)
NEXT
RETURN(FILL_OUT(DONE, PADBACK))
//--------------------
Func DENCRYPT( TO_DO )
LOCAL PADBACK := LEN(TO_DO), DONE := " ", QAZ
TO_DO := ALLTRIM(TO_DO)
FOR QAZ = LEN(TO_DO) TO 1 STEP -1
DONE := DONE + CHR(ASC(SUBSTR(TO_DO, QAZ, 1)) - 104)
NEXT
RETURN(FILL_OUT(DONE, PADBACK))
//----------------------
Func FILL_OUT( FILL_A, FILL_B )
IF PCOUNT() = 1
FILL_B := 80
ELSE
IF TYPE("FILL_B") = "C"
FILL_B := VAL(B)
ENDIF
FILL_B := IIF(FILL_B <= 1, 80, FILL_B)
ENDIF
IF FILL_B <= LEN(FILL_A)
RETURN(FILL_A)
ENDIF
RETURN(FILL_A + SPACE(FILL_B - LEN(FILL_A)))
static function OpenData()
local lOpen := .f.
local cKey
cPW := pw()
if ! File( ".\SOURCE.CDX" )
USE ".\SOURCE.DBF" NEW EXCLUSIVE
//cKey := 'DECRYPT( DESCRIPT, "' + cPW + '" )'
cKey := 'DECRYPT( DESCRIPT, pw() )'
INDEX ON &cKey TAG DES
//cKey := 'DECRYPT( DESCRIPT, "' + cPW + '" )'
cKey := 'DECRYPT( DESCRIPT, pw() )'
INDEX ON &cKey TAG CAT
SOURCE->( DBCLOSEAREA() )
endif
cAlias := cGetNewAlias( "SOUR" )
USE ".\SOURCE.DBF" NEW ALIAS (cAlias) SHARED VIA 'DBFCDX'
SET ORDER TO TAG DES
GO TOP
lOpen := Select( cAlias ) > 0
return NIL
//----------------------------------------------------------------------------//
function pw()
return ("mydata")
//----------------------------------------------------------------------------//
function pw()
local cPassword1 := "my"
local cPassword2 := "data"
return ( cPassword1 + cPassword2 )
//----------------------------------------------------------------------------//
#include 'fivewin.ch'
#include 'xbrowse.ch'
REQUEST DBFCDX
static cAlias
static cPW := " "
//----------------------------------------------------------------------------//
function Main()
local cPwd := PadR( cPw, 30 )
if file( ".\SOURCE.DBF")= .F.
DbCreate_source()
endif
if MsgGet( "PASSWORD", "Enter PassWord", @cPwd, nil, nil, .t. )
cPW := AllTrim( cPwd )
endif
if cPW == pw()
else
msginfo("falsch")
return nil
endif
OpenData()
BrowseData( )
return nil
//----------------------------------------------------------------------------//
function BrowseData( )
local oWnd, oBrw, oFont, nArea, oRes, cMemo
cMemo := Decrypt( ( cAlias )->Source, cPW )
DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-12
DEFINE WINDOW oWnd STYLE nOr( WS_POPUP, WS_MAXIMIZE )
oWnd:SetFont( oFont )
@ 60, 0 XBROWSE oBrw SIZE 500, -40 PIXEL OF oWnd ;
COLUMNS { || Decrypt( FIELD->DESCRIPT, cPW ) }, { || Decrypt( FIELD->KATEGORIE, CPW ) } ;
HEADERS "Descript", "Kategorie" ;
SORT "DES", "CAT" ;
ALIAS cAlias FOOTERS NOBORDER AUTOSORT
WITH OBJECT oBrw
:nRowHeight := 18
:nMarqueeStyle := MARQSTYLE_HIGHLROW
:nRowDividerStyle := LINESTYLE_LIGHTGRAY
:nColDividerStyle := LINESTYLE_LIGHTGRAY
:lColDividerComplete := .t.
:nStretchCol := -1
:nWidths := 200
END
oBrw:bChange := {|| cMemo := Decrypt( ( cAlias )->Source, cPW ) , oRes:refresh() }
oBrw:CreateFromCode()
@ 60,550 GET oRes VAR cMemo MEMO OF oWnd SIZE 400, 470 PIXEL
MakeBtnBar( oBrw )
ACTIVATE WINDOW oWnd ;
ON RESIZE WndResize( oWnd, oRes ) ;
ON INIT oBrw:SetFocus() ;
MAXIMIZED
return nil
static function MakeBtnBar( oBrw )
local oBar
DEFINE BUTTONBAR oBar OF oBrw:oWnd SIZE 48,48 2007
DEFINE BUTTON OF oBar RESOURCE 'ALLADD' ACTION ( add(), oBrw:Refresh(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar RESOURCE 'ALLEDIT' ACTION ( add("EDIT"), oBrw:Refresh(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar RESOURCE 'ALLDELETE' ACTION ( SOURCEdel(), oBrw:gotop(), oBrw:refresh(), oBrw:SetFocus() )
DEFINE BUTTON ;
OF oBar ;
ACTION ( export_Encrypt(), oBrw:refresh(), oBrw:SetFocus() ) ;
PROMPT "Export"
DEFINE BUTTON OF oBar RESOURCE 'ENDE' ACTION ( WndMain():End() )
return nil
//----------------------------------------------------------------------------//
static function WndResize( oWnd, oGet )
local oRect := oWnd:GetCliRect()
oGet:nWidth := oRect:nWidth - oGet:nLeft - 30
oGet:nHeight := oRect:nHeight - oGet:nTop - 40
return nil
//----------------------------------------------------------------------------//
static function OpenData()
local lOpen := .f.
local cKey
cPW := pw()
if ! File( ".\SOURCE.CDX" )
USE ".\SOURCE.DBF" NEW EXCLUSIVE
//cKey := 'DECRYPT( DESCRIPT, "' + cPW + '" )'
cKey := 'DECRYPT( DESCRIPT, pw() )'
INDEX ON &cKey TAG DES
//cKey := 'DECRYPT( DESCRIPT, "' + cPW + '" )'
cKey := 'DECRYPT( DESCRIPT, pw() )'
INDEX ON &cKey TAG CAT
SOURCE->( DBCLOSEAREA() )
endif
cAlias := cGetNewAlias( "SOUR" )
USE ".\SOURCE.DBF" NEW ALIAS (cAlias) SHARED VIA 'DBFCDX'
SET ORDER TO TAG DES
GO TOP
lOpen := Select( cAlias ) > 0
return NIL
//----------------------------------------------------------------------------//
function pw()
local cPassword1 := "m"
local cPassword2 := "y"
local cPassword3 := "d"
local cFiller := "xyz"
local cPassword4 := "a"
local cPassword5 := "t"
local cPassword6 := "a"
*----------------------------------------------------------
return ( cPassword1 + cPassword2 + cPassword3 + cPassword4 + cPassword5 + cPassword6 )
//----------------------------------------------------------------------------//
static function add(cAufruf)
local oDlg
local lOk := .f.
local oGetDesc
local oGetCat
local oGetSource
local cDesc := space(50)
local cTCat := space(50)
local cSource := ""
*----------------------------------------------------------
if cAufruf = "EDIT"
cDesc := Decrypt( ( cAlias )->DESCRIPT, cPW )
cTCat := Decrypt( ( cAlias )->KATEGORIE, cPW )
cSource := Decrypt( ( cAlias )->SOURCE, cPW )
endif
DEFINE DIALOG oDlg RESOURCE "ADDSOURCE"
REDEFINE GET oGetDesc VAR cDesc ID 4001 OF oDlg
REDEFINE GET oGetCat VAR cTCat ID 4002 OF oDlg
REDEFINE GET oGetSource VAR cSource MULTILINE ID 4003 OF oDlg UPDATE
REDEFINE BUTTONBMP ID 2 OF oDlg ;
ACTION oDlg:END() CANCEL ;
BITMAP ".\bitmaps\Delete.bmp" TEXTRIGHT
REDEFINE BUTTON ID 1 OF oDlg ACTION (lOK := .t., oDlg:End() )
ACTIVATE DIALOG oDlg
if lOK = .t.
if cAufruf <> "EDIT"
append_blank()
else
rlok()
endif
( cAlias )->DESCRIPT := Encrypt( cDesc, cPW )
( cAlias )->KATEGORIE := Encrypt( cTCat, cPW )
( cAlias )->SOURCE := Encrypt( cSource, cPW )
unlok()
endif
return nil
//----------------------------------------------------------------------------//
function export_Encrypt
DbCreate( ".\CLEARTXT.DBF" ,;
{{"DESCRIPT" , "C", 50, 0} ,;
{"KATEGORIE" , "C", 50, 0} ,;
{"SOURCE" , "M", 10, 0} } )
use ( ".\CLEARTXT.DBF" ) NEW
DbSelectArea( cAlias )
set index to
go TOP
do while .not. eof()
select CLEARTXT
append_blank()
CLEARTXT->DESCRIPT := Decrypt( ( cAlias )->DESCRIPT, cPW )
CLEARTXT->KATEGORIE := Decrypt( ( cAlias )->KATEGORIE, cPW )
CLEARTXT->SOURCE := Decrypt( ( cAlias )->SOURCE, cPW )
UNLOK()
DbSelectArea( cAlias )
( cAlias )->( DBSKIP() )
enddo
select CLEARTXT
use
DbSelectArea( cAlias )
go TOP
MSGINFO("Ende")
return nil
//----------------------------------------------------------------------------//
function SOURCEdel()
if msgyesNo("löschen")=.t.
rlok()
Delete
unlok()
endif
return nil
//----------------------------------------------------------------------------//
INIT PROCEDURE PrgInit
SET CENTURY ON
SET EPOCH TO YEAR(DATE())-98
SET DELETED ON
SET EXCLUSIVE OFF
REQUEST HB_Lang_DE
REQUEST HB_CODEPAGE_DEWIN
HB_LangSelect("DE")
HB_SetCodePage("DEWIN")
SET DATE TO GERMAN
SetHandleCount(205)
rddsetdefault( "DBFCDX" )
SetGetColorFocus()
EXTERN DESCEND
RETURN
//----------------------------------------------------------------------------//
function TInhalt
RETURN nil
//----------------------------------------------------------------------------//
function DbCreate_source()
DbCreate( ".\SOURCE.DBF" ,;
{{"DESCRIPT" , "C", 50, 0} ,;
{"KATEGORIE" , "C", 50, 0} ,;
{"SOURCE" , "M", 10, 0} } )
return nil
//----------------------------------------------------------------------------//
*** ALLGEMEINE FUNKTIONEN
FUNCTION RLOK
if rlock()
RETURN ""
endif
DO WHILE .T.
if rlock()
exit
else
MsgInfo("Datensatz gesperrt!")
endif
INKEY(.01)
ENDDO
RETURN ""
FUNCTION APPEND_BLANK
APPEND BLANK
DO WHILE NETERR()
APPEND BLANK
INKEY(.1)
ENDDO
unlock
rlok()
RETURN ""
//----------------------------------------------------------------------------//
FUNCTION unlok
unlock
RETURN (NIL)
//----------------------------------------------------------------------------//
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 75 guests