Initial Commit

This commit is contained in:
Rino Russo 2023-02-02 22:39:42 +01:00
parent bc11aa10c9
commit 09065dd2ce
37 changed files with 7176 additions and 0 deletions

BIN
Bin/DataLock.exe Normal file

Binary file not shown.

28
DataLock.INI Normal file
View File

@ -0,0 +1,28 @@
[General]
Exists=1
[View]
CSize=0
CMethod=0
CRatio=0
CRC=0
EFA=0
IFA=0
Encryption=0
TimeStamp=0
USize=0
MadeBy=0
Needed=0
Comment=0
Hierarchy=1
[Preferences]
BaseDirectory=C:\Users\rinor\Downloads\LDK
Confirmations=0
CompressionMethodToUse=2
DeflationOption=2
CreateDirs=1
RestorePath=1
StripPath=0
RemoveDots=1
Recurse=1

180
DataLock.ctpr Normal file
View File

@ -0,0 +1,180 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="DataLock"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N Value="True"/>
<OutDir Value="lang"/>
<ExcludedIdentifiers Count="1">
<Item1 Value="TFmWriter.*"/>
</ExcludedIdentifiers>
</i18n>
<VersionInfo>
<UseVersionInfo Value="True"/>
<AutoIncrementBuild Value="True"/>
<MinorVersionNr Value="1"/>
<RevisionNr Value="1"/>
<BuildNr Value="94"/>
<Language Value="0410"/>
<StringTable ProductVersion="0.0.0.0"/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="pl_onguard"/>
</Item1>
<Item2>
<PackageName Value="pl_DCP"/>
</Item2>
<Item3>
<PackageName Value="pl_abbrevia"/>
</Item3>
<Item4>
<PackageName Value="adLCL"/>
</Item4>
</RequiredPackages>
<Units Count="12">
<Unit0>
<Filename Value="DataLock.ppr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="ubasedlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="BaseDirDlg"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="udemodlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="DemoDlg"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit2>
<Unit3>
<Filename Value="dgAbout.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="dlgAboutBox"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit3>
<Unit4>
<Filename Value="UMain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit4>
<Unit5>
<Filename Value="unit2.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form2"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit5>
<Unit6>
<Filename Value="unit_open.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="form_open"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit6>
<Unit7>
<Filename Value="unit_crypt.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_crypt"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit7>
<Unit8>
<Filename Value="FmWriter.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="WriterForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit8>
<Unit9>
<Filename Value="FmReader.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="ReaderForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit9>
<Unit10>
<Filename Value="unit_crea_apri.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_creaapri"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit10>
<Unit11>
<Filename Value="unit_pin.pas"/>
<FRMtype Value="0"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="FormPin"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit11>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="DataLock"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="unit_obj"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

335
DataLock.ctps Normal file
View File

@ -0,0 +1,335 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="12"/>
<BuildModes Active="Default"/>
<Units Count="18">
<Unit0>
<Filename Value="DataLock.ppr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<CursorPos X="13" Y="13"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="ubasedlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="BaseDirDlg"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<CursorPos X="11" Y="21"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="udemodlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="DemoDlg"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="11"/>
<WindowIndex Value="0"/>
<CursorPos Y="20"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit2>
<Unit3>
<Filename Value="dgAbout.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="dlgAboutBox"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="8"/>
<WindowIndex Value="0"/>
<CursorPos Y="20"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit3>
<Unit4>
<Filename Value="UMain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="1484"/>
<CursorPos X="41" Y="1500"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit4>
<Unit5>
<Filename Value="unit2.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form2"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<CursorPos X="5" Y="19"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit5>
<Unit6>
<Filename Value="unit_open.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="form_open"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<CursorPos X="5" Y="19"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit6>
<Unit7>
<Filename Value="unit_crypt.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_crypt"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="9"/>
<WindowIndex Value="0"/>
<CursorPos X="5" Y="19"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit7>
<Unit8>
<Filename Value="FmWriter.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="WriterForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="10"/>
<WindowIndex Value="0"/>
<CursorPos X="5" Y="19"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit8>
<Unit9>
<Filename Value="FmReader.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="ReaderForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<CursorPos X="5" Y="19"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit9>
<Unit10>
<Filename Value="unit_crea_apri.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_creaapri"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<CursorPos X="5" Y="19"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit10>
<Unit11>
<Filename Value="unit_pin.pas"/>
<FRMtype Value="0"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="FormPin"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="7"/>
<WindowIndex Value="0"/>
<CursorPos X="5" Y="19"/>
<UsageCount Value="34"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit11>
<Unit12>
<Filename Value="usplash.pas"/>
<HasResources Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="0"/>
<UsageCount Value="36"/>
</Unit12>
<Unit13>
<Filename Value="C:\codetyphon\typhon\lcl\include\control.inc"/>
<FRMtype Value="0"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="0"/>
<CursorPos Y="3606"/>
<UsageCount Value="26"/>
</Unit13>
<Unit14>
<Filename Value="C:\codetyphon\typhon\components\packages_pl\pl_Abbrevia\source\AbArcTyp.pas"/>
<FRMtype Value="0"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="0"/>
<TopLine Value="562"/>
<CursorPos X="16" Y="582"/>
<UsageCount Value="10"/>
</Unit14>
<Unit15>
<Filename Value="C:\codetyphon\typhon\components\packages_pl\pl_Abbrevia\source\AbConst.pas"/>
<FRMtype Value="0"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="0"/>
<TopLine Value="186"/>
<UsageCount Value="10"/>
</Unit15>
<Unit16>
<Filename Value="C:\codetyphon\typhon\components\packages_pl\pl_Abbrevia\source\AbResString.pas"/>
<FRMtype Value="0"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="0"/>
<TopLine Value="228"/>
<UsageCount Value="10"/>
</Unit16>
<Unit17>
<Filename Value="C:\codetyphon\typhon\components\packages_pl\pl_Abbrevia\source\AbDfBase.pas"/>
<FRMtype Value="0"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="0"/>
<TopLine Value="259"/>
<UsageCount Value="10"/>
</Unit17>
</Units>
<JumpHistory Count="29" HistoryIndex="28">
<Position1>
<Filename Value="UMain.pas"/>
<Caret Line="474" TopLine="470"/>
</Position1>
<Position2>
<Filename Value="UMain.pas"/>
<Caret Line="473" TopLine="469"/>
</Position2>
<Position3>
<Filename Value="UMain.pas"/>
<Caret Line="472" TopLine="468"/>
</Position3>
<Position4>
<Filename Value="UMain.pas"/>
<Caret Line="471" TopLine="467"/>
</Position4>
<Position5>
<Filename Value="UMain.pas"/>
<Caret Line="482" TopLine="478"/>
</Position5>
<Position6>
<Filename Value="UMain.pas"/>
<Caret Line="481" TopLine="477"/>
</Position6>
<Position7>
<Filename Value="UMain.pas"/>
<Caret Line="482" TopLine="478"/>
</Position7>
<Position8>
<Filename Value="UMain.pas"/>
<Caret Line="681" Column="3" TopLine="676"/>
</Position8>
<Position9>
<Filename Value="UMain.pas"/>
<Caret Line="205" Column="15" TopLine="194"/>
</Position9>
<Position10>
<Filename Value="UMain.pas"/>
<Caret Line="680" TopLine="675"/>
</Position10>
<Position11>
<Filename Value="UMain.pas"/>
<Caret Line="684" Column="19" TopLine="668"/>
</Position11>
<Position12>
<Filename Value="UMain.pas"/>
<Caret Line="683" Column="38" TopLine="672"/>
</Position12>
<Position13>
<Filename Value="UMain.pas"/>
<Caret Line="686" Column="27" TopLine="676"/>
</Position13>
<Position14>
<Filename Value="UMain.pas"/>
<Caret Line="1343" Column="15" TopLine="1338"/>
</Position14>
<Position15>
<Filename Value="UMain.pas"/>
<Caret Line="696" Column="54" TopLine="688"/>
</Position15>
<Position16>
<Filename Value="UMain.pas"/>
<Caret Line="692" Column="31" TopLine="690"/>
</Position16>
<Position17>
<Filename Value="UMain.pas"/>
<Caret Line="693" Column="3" TopLine="691"/>
</Position17>
<Position18>
<Filename Value="UMain.pas"/>
<Caret Line="1610" Column="3" TopLine="1608"/>
</Position18>
<Position19>
<Filename Value="UMain.pas"/>
<Caret Line="1343" Column="3" TopLine="1341"/>
</Position19>
<Position20>
<Filename Value="UMain.pas"/>
<Caret Line="1591" Column="3" TopLine="1589"/>
</Position20>
<Position21>
<Filename Value="UMain.pas"/>
<Caret Line="693" Column="3" TopLine="691"/>
</Position21>
<Position22>
<Filename Value="UMain.pas"/>
<Caret Line="689" Column="31" TopLine="679"/>
</Position22>
<Position23>
<Filename Value="UMain.pas"/>
<Caret Line="1232" Column="36" TopLine="1228"/>
</Position23>
<Position24>
<Filename Value="UMain.pas"/>
<Caret Line="731" TopLine="726"/>
</Position24>
<Position25>
<Filename Value="UMain.pas"/>
<Caret Line="1231" TopLine="1227"/>
</Position25>
<Position26>
<Filename Value="UMain.pas"/>
<Caret Line="1067" Column="3" TopLine="1055"/>
</Position26>
<Position27>
<Filename Value="UMain.pas"/>
<Caret Line="728" Column="22" TopLine="717"/>
</Position27>
<Position28>
<Filename Value="ubasedlg.pas"/>
<Caret Line="7" Column="6"/>
</Position28>
<Position29>
<Filename Value="ubasedlg.pas"/>
<Caret Line="21" Column="11"/>
</Position29>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes ActiveMode="default"/>
</RunParams>
</ProjectSession>
</CONFIG>

BIN
DataLock.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 181 KiB

55
DataLock.ppr Normal file
View File

@ -0,0 +1,55 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
program DataLock;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms,
ubasedlg ,
udemodlg ,
dgAbout ,
UMain, unit2,unit_open,unit_crypt,fmwriter,fmreader,unit_crea_apri, onguardstarter, unit_pin
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TBaseDirDlg, BaseDirDlg);
Application.CreateForm(Tform_open, form_open);
Application.CreateForm(Tform_crypt, form_crypt);
Application.CreateForm(TWriterForm, WriterForm);
Application.CreateForm(TformPin, formPin);
Application.CreateForm(TReaderForm, ReaderForm);
Application.CreateForm(Tform_creaapri, form_creaapri);
OnGuard_Init; //==== INIT OnGuard Engine ======================
Application.Run;
OnGuard_Stop; //==== STOP OnGuard Engine ======================
end.

BIN
DataLock.res Normal file

Binary file not shown.

119
FmReader.frm Normal file
View File

@ -0,0 +1,119 @@
object ReaderForm: TReaderForm
Left = 387
Height = 336
Top = 242
Width = 629
BorderStyle = bsToolWindow
Caption = 'Payload Reader Demo: Reader.exe'
ClientHeight = 336
ClientWidth = 629
Color = clBtnFace
DesignTimePPI = 120
Font.Color = clWindowText
Font.Height = -14
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '7.7'
object lblHelp: TLabel
Left = 0
Height = 65
Top = 0
Width = 629
Align = alTop
AutoSize = False
Caption = 'This program displays the data (if any) attached as a payload to the program file. The length of any data is also displayed.'
Color = clBtnHighlight
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
ParentFont = False
Transparent = False
WordWrap = True
end
object lblSize: TLabel
Left = 0
Height = 16
Top = 280
Width = 40
Caption = 'lblSize'
end
object memData: TMemo
Left = 0
Height = 96
Top = 65
Width = 629
Align = alTop
ParentColor = True
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 0
end
object btnClose: TButton
Left = 506
Height = 31
Top = 300
Width = 94
Caption = '&Close'
OnClick = btnCloseClick
TabOrder = 1
end
object Button1: TButton
Left = 0
Height = 31
Top = 300
Width = 94
Caption = 'Controlla file'
OnClick = Button1Click
TabOrder = 2
end
object Button2: TButton
Left = 110
Height = 31
Top = 300
Width = 160
Caption = 'Controlla con decrypt'
OnClick = Button2Click
TabOrder = 3
end
object editpin: TLabeledEdit
Left = 0
Height = 24
Top = 210
Width = 100
EditLabel.Height = 16
EditLabel.Width = 100
EditLabel.Caption = 'PIN'
TabOrder = 4
end
object editcodserial: TLabeledEdit
Left = 120
Height = 24
Top = 210
Width = 240
EditLabel.Height = 16
EditLabel.Width = 240
EditLabel.Caption = 'CODICE SERIALE DEL FILE'
TabOrder = 5
end
object editcodregistraz: TLabeledEdit
Left = 380
Height = 24
Top = 210
Width = 240
EditLabel.Height = 16
EditLabel.Width = 240
EditLabel.Caption = 'CODICE REGISTRAZIONE DEL FILE'
TabOrder = 6
end
object editcodapp: TLabeledEdit
Left = 120
Height = 24
Top = 260
Width = 240
EditLabel.Height = 16
EditLabel.Width = 240
EditLabel.Caption = 'CODICE APPLICAZIONE DEL FILE'
TabOrder = 7
end
end

248
FmReader.pas Normal file
View File

@ -0,0 +1,248 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit FmReader;
{$MODE Delphi}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
{ TReaderForm }
TReaderForm = class(TForm)
Button1: TButton;
Button2: TButton;
editcodapp: TLabeledEdit;
editcodregistraz: TLabeledEdit;
editpin: TLabeledEdit;
editcodserial: TLabeledEdit;
memData: TMemo;
btnClose: TButton;
lblHelp: TLabel;
lblSize: TLabel;
procedure btnCloseClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
var cReaderFile, pin, codseriale, codregistrazione :string;
PayloadPresent :boolean;
end;
var
ReaderForm: TReaderForm;
implementation
uses
UPayload,md5,unit_crypt,umain, unit_pin;
{$R *.frm}
procedure TReaderForm.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TReaderForm.Button1Click(Sender: TObject);
var
PL: TPayload;
DataStr: string;
begin
PL := TPayload.Create(cReaderFile);
try
if PL.HasPayload then
begin
lblSize.Caption := Format('Payload data size = %d', [PL.PayloadSize]);
SetLength(DataStr, PL.PayloadSize);
PL.GetPayload(PChar(DataStr)^);
// form_crypt.strsorg.Text:=DataStr;
// form_crypt.btnDecrypt1click(sender);
// memData.Text := form_crypt.strdest.Text;
// memData.Text := copy(DataStr,0,6); // lunghezza nome sigillo per Eureka
// memData.Text := copy(DataStr,0,11); // lunghezza nome sigillo per SecureDrive
memData.Text := copy(DataStr,0,7); // lunghezza nome sigillo per DataLck
form_crypt.strsorg.Text:=copy(DataStr,pos('-',DataStr)+1,length(DataStr));
form_crypt.btnDecrypt1click(sender);
editcodserial.Text:=form_crypt.strdest.Text;
//if MD5Print(MD5String(memdata.Lines[0])) = memdata.Lines[1] then showmessage('match') else showmessage('not match');
end
else
begin
lblSize.Caption := 'No payload present';
lblSize.Font.Style := [fsBold];
end;
finally
PL.Free;
end;
end;
procedure TReaderForm.Button2Click(Sender: TObject);
var
PL: TPayload;
DataStr: string;
pos1,pos2,pos3:integer;
begin
PayloadPresent:=false;
PL := TPayload.Create(cReaderFile);
try
if PL.HasPayload then
begin
lblSize.Caption := Format('Payload data size = %d', [PL.PayloadSize]);
SetLength(DataStr, PL.PayloadSize);
PL.GetPayload(PChar(DataStr)^);
//showmessage('chiave eureka pre decrypt '+DataStr);
form_crypt.strsorg.Text:=copy(DataStr,0,pos('-',DataStr)-1);
form_crypt.btnDecrypt1click(sender);
editpin.Text := form_crypt.strdest.Text;
// showmessage('pin '+form_crypt.strdest.Text);
if formPin.showmodal= mrOk then begin
pin:=formPin.pwd.Text;
end;
// InputQuery('PIN Secure Drive', '', TRUE, pin);
if pin <> editpin.Text then begin
showmessage('Pin not recognized!');
application.Terminate;
end;
PayloadPresent:=true; // payload presente e codice pin corretto
//form_crypt.ShowModal;
// form_crypt.strsorg.Text:=copy(DataStr,pos('-',DataStr)+1,length(DataStr));
pos1:=pos('-',DataStr);
pos2:=pos('{',DataStr);
pos2:=pos2-pos1;
//showmessage('- '+inttostr(pos1)+' { '+inttostr(pos2)+' } '+inttostr(pos3));
form_crypt.strsorg.Text:=copy(DataStr,pos1+1,pos2-1);
form_crypt.btnDecrypt1click(sender);
//showmessage('chiave eureka pre decrypt '+form_crypt.strsorg.Text);
//showmessage('chiave eureka post decrypt '+form_crypt.strdest.Text);
//memData.Text := form_crypt.strdest.Text; // imposta chiave a quella decodificata
memData.Text := form_crypt.strsorg.Text; // imposta chiave a quella criptata
editcodserial.Text := form_crypt.strdest.Text;
codseriale:=form_crypt.strdest.Text;;
// form_crypt.strsorg.Text:=copy(DataStr,pos('{',DataStr)+1,length(DataStr));
// form_crypt.btnDecrypt1click(sender);
// editcodregistraz.Text := form_crypt.strdest.Text;
pos3:=pos('}',DataStr);
pos2:=pos('{',DataStr);
pos3:=pos3-pos2;
editcodregistraz.Text:=copy(DataStr,pos('{',DataStr)+1,pos3-1);
//showmessage('cod registrazione '+editcodregistraz.Text);
codregistrazione:=editcodregistraz.Text;
form_crypt.strsorg.Text:=copy(DataStr,pos('}',DataStr)+1,length(DataStr));
form_crypt.btnDecrypt1click(sender);
editcodapp.Text := form_crypt.strdest.Text;
//showmessage('cod applicazione '+editcodapp.Text);
showmessage('cod app '+editcodapp.text+' cod licenza '+editcodserial.Text);
if MD5Print(MD5String(trim(editcodapp.text))) <> editcodserial.Text then begin
showmessage('Questa copia è stata manomessa! Impossibile usarla.');
application.terminate;
end;
// show;
form1.OgDaysCode1.AutoDecrease:=true;
form1.OgDaysCode1.AutoCheck:=true;
form1.OgDaysCode1.CheckCode(true);
//exit;
// memData.Text := DataStr;
//if MD5Print(MD5String(memdata.Lines[0])) = memdata.Lines[1] then showmessage('match') else showmessage('not match');
end
else
begin
lblSize.Caption := 'No payload present';
lblSize.Font.Style := [fsBold];
PayloadPresent:=false;
showmessage('Datalock is in unsafe mode. Upgrade to Premium.');
Form1.Statuslbl.Caption:='Datalock is in unsafe mode. Upgrade to Premium.';
// application.Terminate;
end;
finally
PL.Free;
end;
end;
procedure TReaderForm.FormCreate(Sender: TObject);
begin
PayloadPresent:=false;
cReaderFile:=application.ExeName;
// Button1Click(sender);
// Form_crypt.KeyStr:='pRYXo6s5';
Form_crypt.KeyStr:='pRYXo6s5';
Button2Click(sender);
//Form_crypt.KeyStr:=memData.Text;
//showmessage('chiave DataLock: '+memData.Text);
(*
if memData.Text='' then begin
showmessage('Questa copia non è originale, impossibile da usare!');
application.Terminate;
end;
*)
end;
end.

161
FmWriter.frm Normal file
View File

@ -0,0 +1,161 @@
object WriterForm: TWriterForm
Left = 387
Height = 519
Top = 242
Width = 652
BorderStyle = bsDialog
Caption = 'Payload Writer Demo: Writer.exe'
ClientHeight = 519
ClientWidth = 652
Color = clBtnFace
DesignTimePPI = 120
Font.Color = clWindowText
Font.Height = -14
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '7.7'
object lblHelp: TLabel
Left = 0
Height = 81
Top = 0
Width = 652
Align = alTop
AutoSize = False
Caption = 'Enter some text into the control below and click the Store button to write the text as a "payload" in the Reader.exe program. Alternatively click the Delete button to remove any payload from Reader.exe.'
Color = clBtnHighlight
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
ParentFont = False
Transparent = False
WordWrap = True
end
object memData: TMemo
Left = 0
Height = 50
Top = 240
Width = 444
Lines.Strings = (
'DataLck'
)
ScrollBars = ssVertical
TabOrder = 0
end
object btnStore: TButton
Left = 0
Height = 31
Top = 449
Width = 94
Caption = '&Store'
OnClick = btnStoreClick
TabOrder = 1
end
object btnDelete: TButton
Left = 230
Height = 31
Top = 449
Width = 94
Caption = '&Delete'
OnClick = btnDeleteClick
TabOrder = 2
end
object btnClose: TButton
Left = 340
Height = 31
Top = 449
Width = 94
Caption = '&Close'
OnClick = btnCloseClick
TabOrder = 3
end
object Edit1: TEdit
Left = 0
Height = 24
Top = 90
Width = 300
TabOrder = 4
end
object Button1: TButton
Left = 0
Height = 31
Top = 120
Width = 124
Caption = 'Crea unique id'
OnClick = Button1Click
TabOrder = 5
end
object Edit2: TEdit
Left = 320
Height = 24
Top = 90
Width = 200
TabOrder = 6
end
object Button2: TButton
Left = 320
Height = 31
Top = 120
Width = 121
Caption = 'Preleva data ora'
OnClick = Button2Click
TabOrder = 7
end
object Edit3: TEdit
Left = 2
Height = 24
Top = 161
Width = 518
TabOrder = 8
end
object Edit4: TEdit
Left = 2
Height = 24
Top = 196
Width = 518
TabOrder = 9
end
object Button3: TButton
Left = 470
Height = 31
Top = 240
Width = 150
Caption = 'Match codici'
OnClick = Button3Click
TabOrder = 10
end
object Label1: TLabel
Left = 532
Height = 16
Top = 161
Width = 41
Caption = 'codice'
end
object Label2: TLabel
Left = 531
Height = 16
Top = 199
Width = 26
Caption = 'md5'
end
object memData1: TMemo
Left = 0
Height = 50
Top = 300
Width = 444
Lines.Strings = (
'pRYXo6s5'
)
ScrollBars = ssVertical
TabOrder = 11
end
object btnStore1: TButton
Left = 110
Height = 31
Top = 450
Width = 94
Caption = '&Store con seriale'
OnClick = btnStore1Click
TabOrder = 12
end
end

174
FmWriter.pas Normal file
View File

@ -0,0 +1,174 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit FmWriter;
{$MODE Delphi}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, md5;
type
{ TWriterForm }
TWriterForm = class(TForm)
btnStore1: TButton;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label1: TLabel;
Label2: TLabel;
lblHelp: TLabel;
memData: TMemo;
btnStore: TButton;
btnDelete: TButton;
btnClose: TButton;
memData1: TMemo;
procedure btnCloseClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnStore1Click(Sender: TObject);
procedure btnStoreClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
var cReaderFile:string;
end;
var
WriterForm: TWriterForm;
implementation
uses
UPayload,umain,unit_crypt;
//const
// cReaderFile = 'Reader.exe';
{$R *.frm}
procedure TWriterForm.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TWriterForm.btnDeleteClick(Sender: TObject);
var
PL: TPayload;
begin
PL := TPayload.Create(cReaderFile);
try
PL.RemovePayload;
finally
PL.Free;
end;
end;
procedure TWriterForm.btnStore1Click(Sender: TObject);
var
PL: TPayload;
sigillo:string;
begin
form_crypt.strsorg.Text:=form1.codiceserialepersonale;
Form_crypt.btnEncrypt1Click(Sender);
sigillo:=memData.Text+'-'+form_crypt.strdest.Text;
PL := TPayload.Create(cReaderFile);
try
PL.SetPayload(PChar(sigillo)^, Length(sigillo));
finally
PL.Free;
end;
end;
procedure TWriterForm.btnStoreClick(Sender: TObject);
var
PL: TPayload;
begin
PL := TPayload.Create(cReaderFile);
try
PL.SetPayload(PChar(memData.Text)^, Length(memData.Text));
finally
PL.Free;
end;
end;
procedure TWriterForm.Button1Click(Sender: TObject);
var uid:tguid;
begin
createguid(uid);
edit1.Caption:=guidtostring(uid);
edit1.Text:=stringreplace(edit1.Text,'-','',[rfReplaceAll,rfIgnoreCase]);
edit1.Text:=stringreplace(edit1.Text,'{','',[rfReplaceAll,rfIgnoreCase]);
edit1.Text:=stringreplace(edit1.Text,'}','',[rfReplaceAll,rfIgnoreCase]);
edit3.Caption:=edit1.Caption+edit2.Caption;
edit4.Text:=MD5Print(MD5String(edit3.text));
end;
procedure TWriterForm.Button2Click(Sender: TObject);
var
MyTime: TDateTime;
begin
MyTime:= Now;
//Writeln('Now it is: ' + DateTimeToStr(MyTime));
//Writeln('Today is: ' + FormatDateTime('yyy-mm-dd hh:nn', MyTime));
edit2.Caption:=FormatDateTime('mmddhhnnss', MyTime);
edit3.Caption:=edit1.Caption+edit2.Caption;
edit4.Text:=MD5Print(MD5String(edit3.text));
end;
procedure TWriterForm.Button3Click(Sender: TObject);
begin
if MD5Print(MD5String(memdata.Lines[0])) = memdata.Lines[1] then showmessage('match') else showmessage('not match');
end;
procedure TWriterForm.FormCreate(Sender: TObject);
begin
if not FileExists(cReaderFile) then
begin
lblHelp.Caption :=
'ERROR:'#13#10'You must compile Reader.exe before using this program.';
lblHelp.Font.Color := clRed;
lblHelp.Font.Style := [fsBold];
btnDelete.Enabled := False;
btnStore.Enabled := False;
end;
end;
end.

1472
UMain.frm Normal file

File diff suppressed because it is too large Load Diff

111
UMain.lrj Normal file
View File

@ -0,0 +1,111 @@
{"version":1,"strings":[
{"hash":145109307,"name":"tform1.caption","sourcebytes":[68,97,116,97,76,111,99,107],"value":"DataLock"},
{"hash":91841967,"name":"tform1.label1.caption","sourcebytes":[80,114,111,110,116,111],"value":"Pronto"},
{"hash":146593836,"name":"tform1.statuslbl.caption","sourcebytes":[83,116,97,116,117,115,108,98,108],"value":"Statuslbl"},
{"hash":41860963,"name":"tform1.img_sd.hint","sourcebytes":[68,97,116,97,76,111,99,107,32,83,105,103,110,97,116,117,114,101,32,83,116,97,116,117,115],"value":"DataLock Signature Status"},
{"hash":198598593,"name":"tform1.label3.caption","sourcebytes":[32,69,115,112,108,111,114,97,32,99,97,114,116,101,108,108,97],"value":" Esplora cartella"},
{"hash":174550499,"name":"tform1.label2.caption","sourcebytes":[83,101,108,101,99,116,101,100,32,70,105,108,101,115],"value":"Selected Files"},
{"hash":106991073,"name":"tform1.toolbar1.caption","sourcebytes":[84,111,111,108,66,97,114,49],"value":"ToolBar1"},
{"hash":21703,"name":"tform1.btnnuovo.hint","sourcebytes":[78,101,119],"value":"New"},
{"hash":190169183,"name":"tform1.btnnuovo.caption","sourcebytes":[98,116,110,110,117,111,118,111],"value":"btnnuovo"},
{"hash":353982,"name":"tform1.btnapri.hint","sourcebytes":[79,112,101,110],"value":"Open"},
{"hash":162826217,"name":"tform1.btnapri.caption","sourcebytes":[98,116,110,97,112,114,105],"value":"btnapri"},
{"hash":196648531,"name":"tform1.btnagg.hint","sourcebytes":[65,100,100,32,100,105,114,101,99,116,111,114,121,32,97,110,100,32,102,105,108,101,115],"value":"Add directory and files"},
{"hash":110839767,"name":"tform1.btnagg.caption","sourcebytes":[98,116,110,97,103,103],"value":"btnagg"},
{"hash":78392485,"name":"tform1.btndel.hint","sourcebytes":[68,101,108,101,116,101],"value":"Delete"},
{"hash":110840508,"name":"tform1.btndel.caption","sourcebytes":[98,116,110,100,101,108],"value":"btndel"},
{"hash":217810916,"name":"tform1.btnestrai.hint","sourcebytes":[69,120,116,114,97,99,116],"value":"Extract"},
{"hash":80400841,"name":"tform1.btnestrai.caption","sourcebytes":[98,116,110,101,115,116,114,97,105],"value":"btnestrai"},
{"hash":366789,"name":"tform1.btnsalva.hint","sourcebytes":[83,97,118,101],"value":"Save"},
{"hash":190416209,"name":"tform1.btnsalva.caption","sourcebytes":[98,116,110,115,97,108,118,97],"value":"btnsalva"},
{"hash":118418750,"name":"tform1.btnsig.hint","sourcebytes":[67,108,111,115,101,32,97,110,100,32,115,105,103,110],"value":"Close and sign"},
{"hash":110844407,"name":"tform1.btnsig.caption","sourcebytes":[98,116,110,115,105,103],"value":"btnsig"},
{"hash":77500789,"name":"tform1.btnchiave.caption","sourcebytes":[98,116,110,99,104,105,97,118,101],"value":"btnchiave"},
{"hash":160486417,"name":"tform1.toolbutton1.caption","sourcebytes":[84,111,111,108,66,117,116,116,111,110,49],"value":"ToolButton1"},
{"hash":145109307,"name":"tform1.panel5.caption","sourcebytes":[68,97,116,97,76,111,99,107],"value":"DataLock"},
{"hash":139204663,"name":"tform1.panellog.caption","sourcebytes":[80,97,110,101,108,76,111,103],"value":"PanelLog"},
{"hash":171904661,"name":"tform1.speedbutton1.hint","sourcebytes":[83,101,108,101,99,116,32,102,105,108,101],"value":"Select file"},
{"hash":11472597,"name":"tform1.menufiledeselect.hint","sourcebytes":[68,101,115,101,108,101,99,116,32,102,105,108,101],"value":"Deselect file"},
{"hash":37355603,"name":"tform1.extractallselected.hint","sourcebytes":[69,120,116,114,97,99,116,32,115,101,108,101,99,116,101,100,32,102,105,108,101,115],"value":"Extract selected files"},
{"hash":210597155,"name":"tform1.deleteallselected.hint","sourcebytes":[68,101,108,101,116,101,32,115,101,108,101,99,116,101,100,32,102,105,108,101,115],"value":"Delete selected files"},
{"hash":59203395,"name":"tform1.menufiledeselectall.hint","sourcebytes":[68,101,115,101,108,101,99,116,32,97,108,108,32,115,101,108,101,99,116,101,100,32,102,105,108,101,115],"value":"Deselect all selected files"},
{"hash":2805797,"name":"tform1.file1.caption","sourcebytes":[38,70,105,108,101],"value":"&File"},
{"hash":4890740,"name":"tform1.menuitem2.caption","sourcebytes":[67,114,121,112,116],"value":"Crypt"},
{"hash":177351,"name":"tform1.menuitem1.caption","sourcebytes":[38,78,101,119],"value":"&New"},
{"hash":2844350,"name":"tform1.open1.caption","sourcebytes":[38,79,112,101,110],"value":"&Open"},
{"hash":2857157,"name":"tform1.save1.caption","sourcebytes":[38,83,97,118,101],"value":"&Save"},
{"hash":118276926,"name":"tform1.close1.caption","sourcebytes":[38,67,108,111,115,101,32,97,110,100,32,83,105,103,110],"value":"&Close and Sign"},
{"hash":254313481,"name":"tform1.convert1.caption","sourcebytes":[38,67,111,110,118,101,114,116,32,40,116,111,32,46,101,120,101,41],"value":"&Convert (to .exe)"},
{"hash":4710148,"name":"tform1.exit1.caption","sourcebytes":[69,38,120,105,116],"value":"E&xit"},
{"hash":238928387,"name":"tform1.preferences1.caption","sourcebytes":[38,80,114,101,102,101,114,101,110,99,101,115],"value":"&Preferences"},
{"hash":92680803,"name":"tform1.confirmations1.caption","sourcebytes":[67,111,110,38,102,105,114,109,97,116,105,111,110,115],"value":"Con&firmations"},
{"hash":111653829,"name":"tform1.compressionmethodtouse1.caption","sourcebytes":[38,67,111,109,112,114,101,115,115,105,111,110,32,77,101,116,104,111,100,32,84,111,32,85,115,101],"value":"&Compression Method To Use"},
{"hash":45790853,"name":"tform1.store1.caption","sourcebytes":[38,83,116,111,114,101],"value":"&Store"},
{"hash":180169221,"name":"tform1.deflate1.caption","sourcebytes":[38,68,101,102,108,97,116,101],"value":"&Deflate"},
{"hash":2788516,"name":"tform1.best1.caption","sourcebytes":[38,66,101,115,116],"value":"&Best"},
{"hash":209459491,"name":"tform1.deflationoption1.caption","sourcebytes":[38,68,101,102,108,97,116,105,111,110,32,79,112,116,105,111,110,115],"value":"&Deflation Options"},
{"hash":190223196,"name":"tform1.normal1.caption","sourcebytes":[38,78,111,114,109,97,108],"value":"&Normal"},
{"hash":64946573,"name":"tform1.maximum1.caption","sourcebytes":[77,97,38,120,105,109,117,109],"value":"Ma&ximum"},
{"hash":2803876,"name":"tform1.fast1.caption","sourcebytes":[38,70,97,115,116],"value":"&Fast"},
{"hash":208626884,"name":"tform1.superfast1.caption","sourcebytes":[38,83,117,112,101,114,32,70,97,115,116],"value":"&Super Fast"},
{"hash":234885267,"name":"tform1.extractoptions1.caption","sourcebytes":[38,69,120,116,114,97,99,116,32,79,112,116,105,111,110,115],"value":"&Extract Options"},
{"hash":123027443,"name":"tform1.createdirs1.caption","sourcebytes":[38,67,114,101,97,116,101,32,68,105,114,101,99,116,111,114,105,101,115],"value":"&Create Directories"},
{"hash":66700264,"name":"tform1.restorepath1.caption","sourcebytes":[38,82,101,115,116,111,114,101,32,80,97,116,104],"value":"&Restore Path"},
{"hash":233813726,"name":"tform1.logging1.caption","sourcebytes":[38,76,111,103,103,105,110,103,46,46,46],"value":"&Logging..."},
{"hash":14613438,"name":"tform1.password1.caption","sourcebytes":[38,80,97,115,115,119,111,114,100,46,46,46],"value":"&Password..."},
{"hash":214729811,"name":"tform1.storeoptions1.caption","sourcebytes":[38,83,116,111,114,101,32,79,112,116,105,111,110,115],"value":"&Store Options"},
{"hash":50205701,"name":"tform1.recursetree1.caption","sourcebytes":[38,82,101,99,117,114,115,101,32,84,114,101,101],"value":"&Recurse Tree"},
{"hash":44494963,"name":"tform1.removedots1.caption","sourcebytes":[82,101,109,111,118,101,32,38,68,111,116,115],"value":"Remove &Dots"},
{"hash":967480,"name":"tform1.strippath1.caption","sourcebytes":[38,83,116,114,105,112,32,80,97,116,104],"value":"&Strip Path"},
{"hash":82476771,"name":"tform1.showemptyfolders1.caption","sourcebytes":[83,38,104,111,119,32,69,109,112,116,121,32,102,111,108,100,101,114,115],"value":"S&how Empty folders"},
{"hash":222564494,"name":"tform1.tempdirectory1.caption","sourcebytes":[38,84,101,109,112,32,68,105,114,101,99,116,111,114,121,46,46,46],"value":"&Temp Directory..."},
{"hash":2871239,"name":"tform1.view1.caption","sourcebytes":[38,86,105,101,119],"value":"&View"},
{"hash":148062579,"name":"tform1.attributes1.caption","sourcebytes":[38,65,116,116,114,105,98,117,116,101,115],"value":"&Attributes"},
{"hash":253755893,"name":"tform1.za0.caption","sourcebytes":[38,67,111,109,112,114,101,115,115,101,100,32,83,105,122,101],"value":"&Compressed Size"},
{"hash":197171188,"name":"tform1.za1.caption","sourcebytes":[67,111,109,112,114,101,115,115,105,111,110,32,38,77,101,116,104,111,100],"value":"Compression &Method"},
{"hash":222513535,"name":"tform1.za2.caption","sourcebytes":[67,111,109,112,114,101,115,115,105,111,110,32,82,38,97,116,105,111],"value":"Compression R&atio"},
{"hash":285539,"name":"tform1.za3.caption","sourcebytes":[67,38,82,67],"value":"C&RC"},
{"hash":71082275,"name":"tform1.za4.caption","sourcebytes":[38,69,120,116,101,114,110,97,108,32,70,105,108,101,32,65,116,116,114,105,98,117,116,101,115],"value":"&External File Attributes"},
{"hash":100049187,"name":"tform1.za5.caption","sourcebytes":[38,73,110,116,101,114,110,97,108,32,70,105,108,101,32,65,116,116,114,105,98,117,116,101,115],"value":"&Internal File Attributes"},
{"hash":171998462,"name":"tform1.za6.caption","sourcebytes":[69,38,110,99,114,121,112,116,105,111,110],"value":"E&ncryption"},
{"hash":124852336,"name":"tform1.za7.caption","sourcebytes":[38,84,105,109,101,32,83,116,97,109,112],"value":"&Time Stamp"},
{"hash":228663797,"name":"tform1.za8.caption","sourcebytes":[38,85,110,99,111,109,112,114,101,115,115,101,100,32,83,105,122,101],"value":"&Uncompressed Size"},
{"hash":182749193,"name":"tform1.za9.caption","sourcebytes":[38,86,101,114,115,105,111,110,32,77,97,100,101,32,66,121],"value":"&Version Made By"},
{"hash":240085892,"name":"tform1.za10.caption","sourcebytes":[86,101,114,115,105,111,110,32,78,101,101,38,100,101,100,32,84,111,32,69,120,116,114,97,99,116],"value":"Version Nee&ded To Extract"},
{"hash":76815668,"name":"tform1.filecomment1.caption","sourcebytes":[38,70,105,108,101,32,67,111,109,109,101,110,116],"value":"&File Comment"},
{"hash":5297733,"name":"tform1.none1.caption","sourcebytes":[78,38,111,110,101],"value":"N&one"},
{"hash":277804,"name":"tform1.all1.caption","sourcebytes":[65,38,108,108],"value":"A&ll"},
{"hash":197386388,"name":"tform1.default1.caption","sourcebytes":[68,101,102,97,38,117,108,116],"value":"Defa&ult"},
{"hash":224752558,"name":"tform1.font1.caption","sourcebytes":[38,70,111,110,116,46,46,46],"value":"&Font..."},
{"hash":45793317,"name":"tform1.style1.caption","sourcebytes":[38,83,116,121,108,101],"value":"&Style"},
{"hash":210380553,"name":"tform1.hierarchy1.caption","sourcebytes":[38,72,105,101,114,97,114,99,104,121],"value":"&Hierarchy"},
{"hash":62331556,"name":"tform1.os1.caption","sourcebytes":[38,79,110,108,121,32,84,101,120,116],"value":"&Only Text"},
{"hash":188813,"name":"tform1.os2.caption","sourcebytes":[43,47,38,45],"value":"+/&-"},
{"hash":182716115,"name":"tform1.os3.caption","sourcebytes":[38,71,108,121,112,104,115],"value":"&Glyphs"},
{"hash":87452275,"name":"tform1.os4.caption","sourcebytes":[38,43,47,45,32,97,110,100,32,71,108,121,112,104,115],"value":"&+/- and Glyphs"},
{"hash":190037381,"name":"tform1.os5.caption","sourcebytes":[79,110,108,121,32,84,38,114,101,101],"value":"Only T&ree"},
{"hash":263772435,"name":"tform1.os6.caption","sourcebytes":[38,84,114,101,101,32,97,110,100,32,71,108,121,112,104,115],"value":"&Tree and Glyphs"},
{"hash":45132867,"name":"tform1.items1.caption","sourcebytes":[38,73,116,101,109,115],"value":"&Items"},
{"hash":106317294,"name":"tform1.addfiles1.caption","sourcebytes":[38,65,100,100,32,70,105,108,101,115,46,46,46],"value":"&Add Files..."},
{"hash":249863950,"name":"tform1.deletefiles1.caption","sourcebytes":[38,68,101,108,101,116,101,32,70,105,108,101,115,46,46,46],"value":"&Delete Files..."},
{"hash":142412926,"name":"tform1.extractfiles1.caption","sourcebytes":[38,69,120,116,114,97,99,116,32,70,105,108,101,115,46,46,46],"value":"&Extract Files..."},
{"hash":133078286,"name":"tform1.freshenfiles1.caption","sourcebytes":[38,70,114,101,115,104,101,110,32,70,105,108,101,115,46,46,46],"value":"&Freshen Files..."},
{"hash":671,"name":"tform1.help1.caption","sourcebytes":[38,63],"value":"&?"},
{"hash":45006757,"name":"tform1.contents1.caption","sourcebytes":[38,71,117,105,100,101],"value":"&Guide"},
{"hash":163200722,"name":"tform1.abbreviaontheweb1.caption","sourcebytes":[68,97,116,97,76,111,99,107,32,111,110,32,116,104,101,32,119,101,98],"value":"DataLock on the web"},
{"hash":56535007,"name":"tform1.about1.caption","sourcebytes":[68,97,116,97,76,111,99,107,32,73,110,102,111],"value":"DataLock Info"},
{"hash":142032114,"name":"tform1.opendialog1.title","sourcebytes":[79,112,101,110,32,68,97,116,97,76,111,99,107,32,70,111,108,100,101,114],"value":"Open DataLock Folder"},
{"hash":171773589,"name":"tform1.menuitemselect.caption","sourcebytes":[83,101,108,101,99,116,32,70,105,108,101],"value":"Select File"},
{"hash":11341525,"name":"tform1.menuitem7.caption","sourcebytes":[68,101,115,101,108,101,99,116,32,70,105,108,101],"value":"Deselect File"},
{"hash":225940473,"name":"tform1.delete1.caption","sourcebytes":[68,101,108,101,116,101,32,83,101,108,101,99,116,101,100,32,70,105,108,101,40,115,41],"value":"Delete Selected File(s)"},
{"hash":65072739,"name":"tform1.menuitem5.caption","sourcebytes":[68,101,108,101,116,101,32,70,105,108,101,115],"value":"Delete Files"},
{"hash":168291657,"name":"tform1.extract1.caption","sourcebytes":[69,115,116,114,97,99,116,32,83,101,108,101,99,116,101,100,32,70,105,108,101,40,115,41],"value":"Estract Selected File(s)"},
{"hash":132824492,"name":"tform1.menuitem6.caption","sourcebytes":[69,120,116,114,97,99,116,32,65,108,108],"value":"Extract All"},
{"hash":227318814,"name":"tform1.freshen1.caption","sourcebytes":[38,70,114,101,115,104,101,110],"value":"&Freshen"},
{"hash":74220478,"name":"tform1.move1.caption","sourcebytes":[38,77,111,118,101,46,46,46],"value":"&Move..."},
{"hash":178622,"name":"tform1.run1.caption","sourcebytes":[38,82,117,110],"value":"&Run"},
{"hash":108280834,"name":"tform1.savedialog1.title","sourcebytes":[83,97,118,101,32,68,97,116,97,76,111,99,107,32,70,111,108,100,101,114],"value":"Save DataLock Folder"},
{"hash":153198629,"name":"tform1.menuitem3.caption","sourcebytes":[69,120,116,114,97,99,116,32,83,101,108,101,99,116,101,100,32,70,105,108,101],"value":"Extract Selected File"},
{"hash":129880899,"name":"tform1.menuitem8.caption","sourcebytes":[69,120,116,114,97,99,116,32,65,108,108,32,83,101,108,101,99,116,101,100,32,70,105,108,101,115],"value":"Extract All Selected Files"},
{"hash":132824492,"name":"tform1.menuitem4.caption","sourcebytes":[69,120,116,114,97,99,116,32,65,108,108],"value":"Extract All"}
]}

2159
UMain.pas Normal file

File diff suppressed because it is too large Load Diff

182
UPayload.pas Normal file
View File

@ -0,0 +1,182 @@
unit UPayload;
{$MODE Delphi}
interface
type
TPayload = class(TObject)
private
fFileName: string;
fOldFileMode: Integer;
fFile: File;
procedure Open(Mode: Integer);
procedure Close;
public
constructor Create(const FileName: string);
function HasPayload: Boolean;
function PayloadSize: Integer;
procedure SetPayload(const Data; const DataSize: Integer);
procedure GetPayload(var Data);
procedure RemovePayload;
end;
implementation
uses
ActiveX;
type
TPayloadFooter = packed record
WaterMark: TGUID;
ExeSize: LongInt;
DataSize: LongInt;
end;
const
cWaterMarkGUID: TGUID =
'{9FABA105-EDA8-45C3-89F4-369315A947EB}';
cReadOnlyMode = 0;
cReadWriteMode = 2;
procedure InitFooter(out Footer: TPayloadFooter);
begin
FillChar(Footer, SizeOf(Footer), 0);
Footer.WaterMark := cWaterMarkGUID;
end;
function ReadFooter(var F: File;
out Footer: TPayloadFooter): Boolean;
var
FileLen: Integer;
begin
// Check that file is large enough for a footer!
FileLen := FileSize(F);
if FileLen > SizeOf(Footer) then
begin
// Big enough: move to start of footer and read it
Seek(F, FileLen - SizeOf(Footer));
BlockRead(F, Footer, SizeOf(Footer));
end
else
// File not large enough for footer: zero it
// .. this ensures watermark is invalid
FillChar(Footer, SizeOf(Footer), 0);
// Return if watermark is valid
Result := IsEqualGUID(Footer.WaterMark, cWaterMarkGUID);
end;
procedure TPayload.Close;
begin
// close file and restores previous file mode
CloseFile(fFile);
FileMode := fOldFileMode;
end;
constructor TPayload.Create(const FileName: string);
begin
inherited Create;
fFileName := FileName;
end;
procedure TPayload.GetPayload(var Data);
var
Footer: TPayloadFooter;
begin
// open file as read only
Open(cReadOnlyMode);
try
// read footer
if ReadFooter(fFile, Footer)
and (Footer.DataSize > 0) then
begin
// move to end of exe code and read data
Seek(fFile, Footer.ExeSize);
BlockRead(fFile, Data, Footer.DataSize);
end;
finally
// close file
Close;
end;
end;
function TPayload.HasPayload: Boolean;
begin
// we have a payload if size is greater than 0
Result := PayloadSize > 0;
end;
procedure TPayload.Open(Mode: Integer);
begin
// open file with given mode, recording current one
fOldFileMode := FileMode;
AssignFile(fFile, fFileName);
FileMode := Mode;
Reset(fFile, 1);
end;
function TPayload.PayloadSize: Integer;
var
Footer: TPayloadFooter;
begin
// open file and assume no data
Result := 0;
Open(cReadOnlyMode);
try
// read footer and if valid return data size
if ReadFooter(fFile, Footer) then
Result := Footer.DataSize;
finally
Close;
end;
end;
procedure TPayload.RemovePayload;
var
PLSize: Integer;
FileLen: Integer;
begin
// get size of payload
PLSize := PayloadSize;
if PLSize > 0 then
begin
// we have payload: open file and get size
Open(cReadWriteMode);
FileLen := FileSize(fFile);
try
// seek to end of exec code an truncate file there
Seek(fFile, FileLen - PLSize - SizeOf(TPayloadFooter));
Truncate(fFile);
finally
Close;
end;
end;
end;
procedure TPayload.SetPayload(const Data;
const DataSize: Integer);
var
Footer: TPayloadFooter;
begin
// remove any existing payload
RemovePayload;
if DataSize > 0 then
begin
// we have some data: open file for writing
Open(cReadWriteMode);
try
// create a new footer with required data
InitFooter(Footer);
Footer.ExeSize := FileSize(fFile);
Footer.DataSize := DataSize;
// write data and footer at end of exe code
Seek(fFile, Footer.ExeSize);
BlockWrite(fFile, Data, DataSize);
BlockWrite(fFile, Footer, SizeOf(Footer));
finally
Close;
end;
end;
end;
end.

View File

258
dgAbout.frm Normal file
View File

@ -0,0 +1,258 @@
object dlgAboutBox: TdlgAboutBox
Left = 387
Height = 237
Top = 213
Width = 676
BorderStyle = bsToolWindow
Caption = 'DataLock Info'
ClientHeight = 237
ClientWidth = 676
Color = clBtnFace
DesignTimePPI = 120
Font.Color = clBlack
Font.Height = -14
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
Position = poMainFormCenter
LCLVersion = '7.7'
object Label1: TLabel
Left = 240
Height = 23
Top = 16
Width = 84
Caption = 'DataLock'
Font.Color = clBlack
Font.Height = -20
Font.Name = 'Arial'
ParentFont = False
end
object Button1: TButton
Left = 568
Height = 51
Top = 176
Width = 94
Caption = 'Ok'
OnClick = Button1Click
TabOrder = 0
end
object Label2: TLabel
Left = 241
Height = 16
Top = 54
Width = 25
Caption = 'PIN:'
end
object lpin: TLabel
Left = 271
Height = 16
Top = 54
Width = 21
Caption = 'lpin'
end
object Label3: TLabel
Left = 242
Height = 16
Top = 78
Width = 75
Caption = 'Registration:'
end
object lreg: TLabel
Left = 344
Height = 16
Top = 78
Width = 23
Caption = 'lreg'
end
object Panel5: TPanel
Left = 0
Height = 237
Top = 0
Width = 224
Align = alLeft
BevelOuter = bvNone
Caption = 'DataLock'
ClientHeight = 237
ClientWidth = 224
Color = 5263440
Font.Color = clYellow
Font.Height = -30
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
TabOrder = 1
object Image1: TImage
Left = 75
Height = 92
Top = 24
Width = 72
Picture.Data = {
1754506F727461626C654E6574776F726B477261706869635A14000089504E47
0D0A1A0A0000000D4948445200000080000000800806000000C33E61CB000014
214944415478DAED5D7B9015557AFF4EDFD7BC194658441E2B2E2B2E89309845
64C124FFAC09064DED6695D272B12A891B5D4C4955FE51A259DC40A994D9D24D
8C160921BBC17235B15637AEE526594D88BBD4802622225B5944566000198679
CFDC47F7C9F79D7BCE9D6F7AEE9DB9AF9EDB30E7547DD37DFBDE397DFA7CBFF3
FB1E7D4E37802DB6D8628B2DB6D8628B2DB6D8628B2DB6D8628B2DD3A2884BED
82366FDE0CE9743A90BA1DC781BD7BF7C2C183072D00C250962F5F0EAB57AF86
471E7924A7F4A094CF4110894420168BC1D6AD5BA1B1B1119E7AEA290B80A92C
9B366D822D5BB6C0C8C808789E07A9546AF4828418B7CF8F19254A29C77706FE
8EEAE3C5FCCEBFA5128FC7D5B6AEAE0EDE7EFB6DD8BE7D3B7CF0C1071600412B
7E686828A774521A0929D5ECFBA592C215CFC575DDDC3E15620502C2BE7DFB2E
2A205C140058BA7429BCF9E69BD0DFDF9F533C7538DF7265D3961443A319E58A
42A37B32AAA73A70DB69C0958F0D0C184CDDD41E320B8F3FFE383CF3CC331600
9596975E7A0956AE5C098383834A09D4C17CB473FA46FBBF1415B11E95F25B78
6815CA65F9A8BEA40ECA9EE314CABBD168F4A758DF0FD1FE9FE0F51A2010080C
33101B1C387020F46C106A00BCF8E28BB062C50A35EAFDCA679DDF98C96436E1
76137E5CA8472D24120965A3E97FCA35035417D6AD1C4BF237E8B3AEEB306E9F
4140ECC473B97E463040A073373737C34D37DD041F7EF8A10540B9CACF37EAB1
9313D8C9DBB0C3FF0C45A032A0A9A9091A1A1A94F293C9A4FA5F3322CB1DFDE4
ED53DD54278180FC8F818101552F7E3F8CB215DBB783DA970F0454C78C193342
0B021156E5B7B7B7AB91976FD4E3A8BC153BF9799426A2DAD6D656A52052CCF0
F0B012365A2B2E8655E85C066404840B172EA836E2794E603B37E06FF6F9CD02
31086DA98DEBD6AD0B9D391061553E8D5E13739BD185A32A821DFA0FB8BB918E
CF9A354B29BEBBBB5B29BF9A4A9F0C0C2D2D2D4AA9E49B74757519C6781CDBF5
909F0D080474ECBDF7DE833BEFBCD30260226FFFB5D75E539DEAA77D547E0B76
E47F63872E232F9B94DFD3D3A3C47478D0CACF171AB6B5B5293B7FE6CC196576
B00D3F45937113B6C9233360A20F0201F92404820D1B365800E42BA74E9D82F3
E7CF8F1BF9D8D1A4FCF770BB88144F544C1D6E6C6C2D0B2997147BF9E597436F
6FAF126CD37E04C16ADC7A0628060404DEF5EBD7C39123472C0078B9F7DE7B55
1E9FA89F1C2F36F2E3D871BFC09F2C9A33678E52FAB973E76AAEF87C8540403E
0199046CDFCF11046B4C3EC198022AC41AF3E6CD0B459B2361E9BC975F7E5951
3F79DC46F9BAD328F66E27E55307EACE0D9D50E9EBEB53BE0131143A890B282C
4500FC8827AA08C0741DC408EFBCF34ECDFBDD0983F2EFBBEF3EE555FB933BD8
595B28A94323863ACD9887308E7E93A720D3442026BF00DBFE87D8EE3F30A6C2
FC8658EEC1071FB426C094E3C78F2B678E3ACE281895BF183BED97F5F5F52A8E
EEECECCCF904612FC45CF3E7CF87B367CF127047F0BA66E1350D1A201098297A
B9FDF6DBE1FDF7DFAF695BA3B5EEAC65CB96A9B89D7BF1DA69FA47632F4F9E3C
99CBF997598EA2D04DFC81227FDF8AF24594B20DF5E9D3A761EEDCB9D4F63A54
F8DF2208EECED12E029980B06AD5AA9A03A0E60C70CF3DF728E78F4685B1FFD8
39BF839FDF208F9FFC02CAC0955108557F859DFD346EBBCAF4F03F8F9B6FA23C
504E5F9119A0EB21DF0001BC00DB72D23884E42C521E61D1A245D31B00C78E1D
53F44F9EBF191D14EFE3762D018068B40CEA7F0DE52E945E7F1A78B2BAF81D43
E66B1013BC4E84556A8848DE3E992F2CBB10E07F6C188E9C417216972C5932BD
9D40FF640E1A75286B67CE9C99CBB0F9EFC54F224FE3FFDF82D2CBBD6FEE3812
D8F2094F28F91CCD5358DF72ACFB9552DA42851C578A0CC8214449F0EF8805EE
BFFFFEE9ED03F847258E8C8D46093ACF5ECACD1CBA01BF99A58E73F5939092C9
A97CF4D147738CC347EB8D37DE086BD6AC5111899E4BE007E75770F75F51D617
DB20AA8B4C01FEAF40B913DBB19B9F33E8296CA106C0B5D75EABA8D0975EFD1A
DD6C21BB59E28C9E0E94FB4DC7F2491CE471D3BDF9C71E7B0C0E1F3E5CB0829D
3B77AAED0B2FBCA0E620D0FD0576F7D1ECFF3ECA4994B9C5368C7C18021C9AB6
F558C76E1FA8A6AF09A0D166B2635470BF0915760DA55669E49448FF1B4CCAD5
742C098D3E9AB479D75D774DA87C5EEEB8E30EB8E5965B9493C6954F5B3C8767
CE55AC507A9852C0B8FFBBDC04D45AF9350780AF63697FAD51A2F9BE18C1FFD9
85F22B5E1F6D49F994777FF6D9674B6E1BE5EAE9F62DE520FC2316CF4537A5DE
2EB26D5C1AF0D85595CE52BAA4006094A53B68A9F603C0EFC04D2458C736BFF2
89459E7CF2C98A6EBA18101013F0B6EAFD6DA5A4890DA8E91A390B4CFB543053
3E297E21D94A33FDAA48F900E538AF87F629CFFEDC73CF55DC3E02C1CD37DFAC
289C030CE52778AEA162DB692686D035F2E3B54E6BD71C008626F5B695924174
5FBD04FBFF069F054CFB145FD3ACDC6A1502414747C718B06AF98F620160EE72
62996DA6A94D7B27304F87AA8E6253BA8BB1B11DFE1145CAAAF6FCBB279E7842
29D0D7DEA2FD00735D325B80FB3AD33E0FE09F62EDCBC24DC6201FF37B08C420
3B76ECA87A1B29822066A1D4346BEB9962B394FE049135018CFE79C798CC6009
3E4027FF4C4A2A36DC2BB5501E8100C6CEF7512959419EF534B399AC09D07971
3E7DBBC4D4AF30FBA49C6DDBB605D6DEFDFBF7039FE1C3CF5D2C08CCB59AEBAC
350344C3C0005CE9E5808887920482A0CAA14387C6F82D85169916D35E0281B9
2D3C6D0190CF09ACC48798AA69E1D568AFB976CB001576A82F9114F888F2D379
A9B7AAA7BABD170D03F00C6039754C2503B01B4325B779AADB7B5131403973FE
B832821E5137DC70C338EFBD5C06988AF64E0B1FC09F43087244D1024FBFED2E
B5CD53D9DE69E103F83B34C811C59F0A52AEF2A6B2BD9601A6200A28F57C9601
58194EA12D951114B72C3ACDFE0F4A164EAA2EAA33A892CCC4C0C32EF324C5FF
1EB4343746E9B135A528712ADB5B1300ACC449AEDFC5895937D0ACFA49D82D99
7E0B8EA52E8311896BFEA011FA9C2F60EF944289F80007D103F5EE595CE33600
75DE59F8DE37DE821F6C0ACA066C87E3C327A1DFBB0A52B20966B4DEFA599AD1
5C3C002A682FDE48FC8BBF01F8CBEF8718001D3825F3FAE5A459D43D5F825160
604BE88656E77F6058CE8714B4400FCE0729C5A7A66A13F23C34C90F210EBD50
8F53F564AA1BBC5440F48F8B7D5BC441F4FCFB2029DAE0FCC7B1A3E02C297C81
D5682FC3D6B7FF08601D0EAC07100807FE2F6400E8C0465D8F0338339447E9C2
FCC98AD09F49D971D98DBBF8E045E807F2878490250000D7DAC93E68109DF8FF
0358D70570C8AF10F1802800DB29FAA05E9EC3B62771FFF34211969065B617D7
3A0A3A1E55DF4A6323408B18CBA21E0EACD538676AFF1EFCEAFA100160E5D5A8
7C5C32E10E31C0D28E83CBB9501952D016394CD0CA1FB4A36A9F967AD54154E2
9C7948601FE2829054BDE7C9740900C099BFD1682A8EB17814EB8C8A663C3A1F
FB2C0D41AC7951CF238499A8447C0015DA6FE146D2E94C1D8822CD966EAF3BDA
5E9A6FB800DB8B9A453FC8C16B9774FD32A344D0BE48653F6B30B828115CF1D0
F1D7F818B43FADC23555A3637EF654169919A96F2F1280230954741C4F905A8F
A3E59B788C1EDDD630513D4E39AD9193BA1A8115A79C1E2CAEBDDD58EF1B1ED4
3D2D4562BFE312089259FF488062CA5813EEDE181200C8BD9AFAC9C3A55E1109
140797730EBF027C11457826C386BB081E3544767A4EE24F946970B32020134A
373DB7FD13C023DFABB10958750DFE496B5BE5283F57D93A470EEFC5435F0263
22A5E25064FD85E045DA081F16104CE1D2431390C1A570C913D9BEA4638236EE
371C77A8DE739A370A87403092FD5E521415021F60DD4A0A8FB04DD858871A46
CBB865720BEE7D49E8518F3406EE67BE06D0B216A9029DBE7417D48EB8C30A02
3499B136EC3F5C517CE1DFC1E97A25EB2C67D9E0EBE00EBE0A4EDDCBE4887AE0
568DBE2B06405A2FECA1C72179CAB1F3228E271F2640A8918F17E45EF92D5CA7
FB33708E3D002293B2CA9EC89CC65AC0BBEC56ECB36D10F915F61B32836202E9
ED40F2570010C2D58C5A253FA6F256671B2384435CF655FC5C4F8090F8D95DF8
103827BE03914F7F9855BE002B138848E3B3044EEF01E7D31F80BBE0CFB37E5F
96F2AFC238F03754D2C990A7170206C8C5A88AFE1151AEBBC684C6DE6C5C4CDB
F977B83AB233DB56691DC1A22D423F3E51D46904AFEDB7C1E9FECFEC18F3C45A
0C95DE5560A952F4533900746308982A8721646B2E7F8161A033F4B1760E6D29
B55F9DDE0EF0E6DE9DED5F47F959AD0A097AB0852211A4A85ED3916AA41EE9A2
FE4A8C66DF1A1DF9B694C904FF0B9E53871D3B42FD2B8133A908030398E4866E
D46822A8059F8E703CEBC95A0094EF5B0D1EC100E1B378EBF428F6B1CC1DA75D
110A1FC098806C221B72F31BD0EE5BC557A1B818EC67FAB37DECD20893B93E0F
050390C2A546243E3A6134AC48768D36D496CA4AF26C36058CF1BF7045364924
01BC303080D1B1A776E45847DF2ABF7ABE8034A65FC5D7EADE61281241634D80
57B50C952DF9BB3A17FC85CD04787AB43B76D40756BC313789426202C6300035
CAB18A0A8C013C36EAC3C200823380B40C102803C8B10C2042C9001600813A82
637204A1F3012C034C290384CB07F0C637D2962A33009F241A1A1F80E7016C14
102C03B018BB4AFAAF0203783C0F60E7F9049F07600C100613E009960AB60C10
781E40701F202C61A0C79C409A156C3110CCE897D92C70CED70A4D18480D11BE
052DB6041B068E490AD53A0CF46C1838E561A017A63050D844D0D433409852C1
96016AC300C232806580F0F8001A8D9601820D034DEC4F775DBDB0AC0B506B1A
C4789AB2A5FAA1A019F5D58AB42AF7014456E9B94490D553700CC014EFC9D141
577313C067048D3E04C9966A8F7E2946FB36B43382EC2AA00041606704D93010
1803D81941D3380CB433822C03847456B005C0F46200EB03581FC032C0543180
60C980D02D0EF5EC8CA0C0190046079A74C2B8385453932DC114A5FBD04D0A1D
B338D44E0A0DD40440D8C3406B028235017671E83467009B0AB661A00D03A733
03D854B06580F0FB001600D38B01047F4A986580C0194084CD07306B03734BC3
2C00022B6A469079974058D606E65607DBE703046F020CF59BC997614C055B13
10A0090008E1F3016C2A786A1920D46120D869E1813340A8C340EB0304CB0022
840C40EF7D36F30154232D0504C7001E0B03693E40A6860058BC7831FCFAB215
70F5828F21290FA31398516FD08CE83781DB120C09982020834F0D5FD68EAF6B
7DEB60F50070DB6DB781EB661548DBE5CB97437B7B3B22CFCB83467C7839F27D
24D5059F0CFC1734A63E8198771E66247F3920EDCA9040349F711A7A4622B320
1D9D01439105D0D6FE65F8E77F590822CF5AAC28BE5972D7AE5D108BC5B4F910
70F0E041387AF4E8D87A1F7EF861B8EEBAEB9442D3E9F43825CB09323B2A1CC5
579934A53E8286F409A8CB9C81D691C35F6F489FFEBE5559F5CB7074F617FBEA
AE7977243A4701A0AFFE0BE03A0D055D81482432EEB343EF2D4670ECDEBD1B0E
1D3A04E2F9E79F9F50C913DA7F85CC3424F08D97F5E9D310CF9C8396D44775B3
877E3E442F09B72AAB6A08D0D9D9F2E579697CEB2A020146A297E3F60AF405E2
657534814101A244E59B37DC91AB17C19D081A81A82BEAA303F12BA37DF5BF16
3BD5FC7B99DEC4D5DFB12B44AB4BFF3D754BBE75AE61AD93726646D34E2BF679
6304DFCA4E3A70985E8A2E64E253A914883D7BF64CA4E442DB8816F559E6FE4F
20209C6822733EB6A273F38F2390596279A072E50F4567BD7E60FEDFDF1DF506
B17F85CCDA7CE9E9C5C2AE169D942FB8CD3B240D008456684C3B86661B659F8D
D2E9735C4BD4070CFA5D0241908865BA9BAF3DBBF5A1864CD762AF647CDA62E6
56F4243EB7EFD09C6F6F174266C4E86BBA8D6229104C69C93030A4F5672369B6
7539180800A4387CDF3B34A034A3E09BE9A15E4B9D96045378DC77DC611145CC
7C87488D535038B7FFF5A573FBFFEDEAA6F499360B83A275EF0DC417749D68F9
CAFB5D4DBFF90B478E90F2479822410300DF27AF8E8F3010A4F4F161B61D4219
44E9D7FB4930B7161000A4B05694D92857A07C467F6ED2A06860CA360048E863
311F0398EFE9782C0BE28894EAA5D26332448E8F711C068E4A4022185339ECA4
A2741DE43AD963234B56A6D7DCD6F38D485F9C4D6FDFA297426530DFE399DF19
057306486BE527D9F7061446E903283D28E7503AF5B647FF4E1A85D1C89F87F2
3994851A0C2D8C09EA7D662156407911EE23A8F749D3F549379F72B95F21F27C
071502A1524071855543F1E0AB8FDBE77CE7345B6EE3DD02204AFBE87E442B9F
40D08782EFF0834F745F1870A40C0004536A8229DC3FFA134CE1DC3F88F83A9C
33827F148A09140605C05029102AF95F59A5F670A50BDF00C8F73BCE3EA64F3D
AD23C980E1B001E73106E06F6C4C33C6363ACB5D5354FFD3804649BDAEA89731
401DDBC698D20D60620540102D81E2797451097587D09CE746ABEB536AB12622
03635F132199A3976466848FFE216DFB07350374A39C4139AF759D31E78B6A2A
E8D507E8CBD3DA24343067CFB0425C2B87FB01091FAA8C1D4EF89CC789006000
152F00A88B55F950C05B979300803B7349E67F48F67DD267FF3DBD1D66001866
7E409FB6FD7DECF74A3169F6CFE4257ECAC2BC18534C9C8D7E1E0DC42700401D
A31EA7804D3426A8AE00A02E7606307D6BBC75EEC9E733570630234CC1F90090
F279FFAE0F687E314049335F227733C8381A298D18C747C963123F3E8A37DF71
0FDFF101273209FD472600D4A540FF69369AD345980197292E9DC774F8E37D8F
3994AECF71F41880C69D373A2EE33CF6476202AFDA81FC69485120632826F1D8
0B01EA1208EBC7286BB2705242FE0C9F2C002E6F82A865D2E8254A3704CC2DE0
49EC52391E7729E15821405D0AC52B10F695137E567C97856E0DD35D41BA552C
D6AD5B071B376E9C0804354B835F420C109E4E45E5D36DE023478EC0ABAFBE0A
FF0F0443538222AE1AC90000000049454E44AE426082
}
Proportional = True
Stretch = True
end
end
end

80
dgAbout.pas Normal file
View File

@ -0,0 +1,80 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit dgAbout;
{$MODE Delphi}
interface
uses
LCLIntf, LCLType, LMessages, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;
type
{ TdlgAboutBox }
TdlgAboutBox = class(TForm)
Button1: TButton;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
lpin: TLabel;
lreg: TLabel;
Panel5: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
dlgAboutBox: TdlgAboutBox;
implementation
{$R *.frm}
uses
AbConst, FmReader;
procedure TdlgAboutBox.FormCreate(Sender: TObject);
begin
lpin.Caption:=ReaderForm.pin;
lreg.Caption:=ReaderForm.codregistrazione;
// lreg.Caption:=ReaderForm.codseriale;
end;
procedure TdlgAboutBox.Button1Click(Sender: TObject);
begin
close;
end;
end.

34
getvers.pas Normal file
View File

@ -0,0 +1,34 @@
unit getvers;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils {$ifdef linux}, getvers_lin {$endif} {$ifdef windows}, getvers_win, getvers_simple_win{$endif} ;
Type
FilePath = String;
Function GetVersion (Var FilePath : String): String;
implementation
Function GetVersion (Var FilePath : String): String;
var xvers : string;
begin
{$ifdef windows}
result:=GetVersionSimpleWin(FilePath);
{$else}
GetProgramVersion(xvers,FilePath);
result:=xvers;
{$endif}
end;
end.

263
getvers_lin.pas Normal file
View File

@ -0,0 +1,263 @@
unit getvers_lin;
{$mode objfpc}{$H+}
interface
uses SysUtils;
Type
TVersionQuad = Array[1..4] of Word;
TVersionCompare = (vcEqual,
vcBuildDiffers,
vcMinorDiffers,
vcMajorDiffers,
vcReleaseDiffers);
Function ExpandVersion(Const S : String) : String;
Function ExtractVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
Function VersionQuadToString(Const Quad : TVersionQuad) : String;
Function CompareVersionQuads(Quad1,Quad2 : TVersionQuad) : TVersionCompare;
// Returns true if Q1 is newer as Q2
Function NewerVersion(Q1,Q2 : TVersionQuad) : Boolean;
Function NewerVersion(V1,V2 : String) : Boolean;
Function CompareVersionString(Quad1,Quad2 : TVersionQuad;Const S1,S2 :
String) : String;
Function GetProgramVersion (Var Version : String; Var FilePath:string): Boolean;
Function GetProgramVersion (Var Version : TVersionQuad; Var FilePath:string) : Boolean;
implementation
uses {$ifdef windows}
fileinfo;
{$else}
resource, elfreader, versiontypes,versionresource;
{$endif}
{$ifndef windows}
Function GetProgramVersion (Var Version : String; Var FilePath:string): Boolean;
Var
C : TVersionQuad;
begin
Result:=GetProgramVersion(C,FilePath);
if Result then
Version:=VersionQuadToString(C);
end;
Function GetProgramVersion (Var Version : TVersionQuad; Var FilePath:string) : Boolean;
Var
RS : TResources;
E : TElfResourceReader;
VR : TVersionResource;
I : Integer;
begin
if FilePath='' then FilePath:=ParamStr(0);
RS:=TResources.Create;
try
E:=TElfResourceReader.Create;
try
Rs.LoadFromFile(FilePath,E);
finally
E.Free;
end;
VR:=Nil;
I:=0;
While (VR=Nil) and (I<RS.Count) do
begin
if RS.Items[i] is TVersionResource then
VR:=TVersionResource(RS.Items[i]);
Inc(I);
end;
Result:=(VR<>Nil);
if Result then
For I:=1 to 4 do
Version[i]:=VR.FixedInfo.FileVersion[I-1];
Finally
RS.FRee;
end;
end;
{$else linux}
Function GetProgramVersion (Var Version : String; Var FilePath:string) : Boolean;
Var
V : TFileVersionInfo;
begin
V:=TFileVersionInfo.Create(Nil);
With V do
try
if FilePath='' then FilePath:=ParamStr(0);
FileName:=FilePath;
// Version:=V.getVersionSetting('ProductVersion');
if (Version='') then
// Version:=V.GetVersionSetting('FileVersion');
Result:=(Version<>'');
Finally
Free;
end;
end;
Function GetProgramVersion (Var Version : TVersionQuad; Var FilePath:string) : Boolean;
Var
S : String;
begin
Result:=GetProgramVersion(S,FilePath);
If Result then
Result:=ExtractVersionQuad(S,Version);
end;
{$endif}
Function CompareVersionQuads(Quad1,Quad2 : TVersionQuad) : TVersionCompare;
Const
EqualResults : Array[1..4] of TVersionCompare =
(vcReleaseDiffers,vcMajorDiffers,vcMinorDiffers,vcBuildDiffers);
Var
I : Integer;
begin
Result:=vcEqual;
I:=1;
While (Result=vcEqual) and (I<5) do
If Quad1[i]<>Quad2[i] then
Result:=EqualResults[i]
else
inc(I);
end;
function ExpandVersion(const S: String): String;
Var
I,Dots : Integer;
begin
Dots:=0;
For i:=1 to length(S) do
if S[i]='.' then
Inc(Dots);
Result:=S;
while (Dots<3) do
begin
Result:=result+'.0';
Inc(Dots);
end;
end;
Function ExtractVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
Var
I,P,Dots,Q : Integer;
begin
Result:=True;
FillChar(Quad,SizeOf(Quad),0);
Dots:=0;
I:=0;
While Result and (S<>'') and (I<4) do
begin
inc(i);
P:=Pos('.',S);
If (P=0) then
P:=Length(S)+1
else
inc(Dots);
Q:=StrToIntDef(Copy(S,1,P-1),-1);
Delete(S,1,P);
Result:=Q<>-1;
If Result then
Quad[I]:=Q;
end;
Result:=(Dots=3);
end;
Resourcestring
SVersionsequal = 'Versione %s e %s sono uguali.';
SDiffers = 'La %s della versione %s (%s) e %s (%s) sono diversi.';
SBuild = 'Build';
SMinor = 'Minor';
SMajor = 'Major';
SRelease = 'Release';
function NewerVersion(V1, V2: String): Boolean;
Var
Q1,Q2 : TVersionQuad;
begin
if ExtractVersionQuad(V1,Q1) and ExtractVersionQuad(V2,Q2) then
Result:=NewerVersion(Q1,Q2)
else
Result:=False;
end;
Function CompareVersionString(Quad1,Quad2 : TVersionQuad;Const S1,S2 :
String) : String;
Var
Fmt,V1,V2 : String;
begin
V1:='';
V2:='';
Case CompareversionQuads(Quad1,Quad2) of
vcBuildDiffers : begin
V1:=Format('%d.%d.%d.%d',[Quad1[1],Quad1[2],Quad1[3],Quad1[4]]);
V2:=Format('%d.%d.%d.%d',[Quad2[1],Quad2[2],Quad2[3],Quad2[4]]);
Fmt:=SBuild;
end;
vcMinorDiffers : begin
V1:=Format('%d.%d.%d',[Quad1[1],Quad1[2],Quad1[3]]);
V2:=Format('%d.%d.%d',[Quad2[1],Quad2[2],Quad2[3]]);
Fmt:=SMinor;
end;
vcMajorDiffers : begin
V1:=Format('%d.%d',[Quad1[1],Quad1[2]]);
V2:=Format('%d.%d',[Quad2[1],Quad2[2]]);
Fmt:=SMajor;
end;
vcReleaseDiffers : begin
V1:=Format('%d',[Quad1[1]]);
V2:=Format('%d',[Quad2[1]]);
Fmt:=SRelease;
end;
end;
If (V1='') and (V2='') then
Result := Format(SVersionsequal,[S1,S2])
else
Result := Format(SDiffers,[Fmt,S1,V1,S2,V2]);
end;
Function VersionQuadToString(Const Quad : TVersionQuad) : String;
begin
Result:=Format('%d.%d.%d.%d',[Quad[1],Quad[2],Quad[3],Quad[4]]);
end;
Function NewerVersion(Q1,Q2 : TVersionQuad) : Boolean;
begin
Result:=False;
Case CompareVersionQuads(Q1,Q2) of
vcEqual : Result:=False;
vcBuildDiffers : Result:=Q1[4]>Q2[4];
vcMinorDiffers : Result:=Q1[3]>Q2[3];
vcMajorDiffers : Result:=Q1[2]>Q2[2];
vcReleaseDiffers : Result:=Q1[1]>Q2[1];
end;
end;
end.

46
getvers_simple_win.pas Normal file
View File

@ -0,0 +1,46 @@
unit getvers_simple_win;
{$mode objfpc} {$H+}
interface
uses
Classes, SysUtils, FileInfo;
type
GetFile = String;
Function GetVersionSimpleWin (Var GetFile : String): String;
implementation
Function GetVersionSimpleWin (Var GetFile : String): String;
var xinfo: tfileversioninfo;
r:word;
txt:string;
begin
if GetFile='' then GetFile:=Paramstr(0);
xinfo := TFileVersionInfo.Create(nil);
xinfo.fileName:=GetFile;
xinfo.ReadFileInfo;
// result:= xinfo.VersionStrings[4]; // fileversion
// txt:=xinfo.VersionStrings[4];
// result:= rightstr(txt,length(txt)-12);
for r:=0 to xinfo.VersionStrings.Count-1 do begin
// if ansipos('fileversion',lowercase(xinfo.VersionStrings[r])) > -1 then begin
if copy(lowercase(xinfo.VersionStrings[r]),0,11)='fileversion' then begin
txt:=xinfo.VersionStrings[r];
result:=rightstr(txt,length(txt)-12);
// break;
// result:='trovato in item '+inttostr(r);
end;
end;
//result:='';
end;
end.

114
getvers_win.pas Normal file
View File

@ -0,0 +1,114 @@
unit getvers_win;
{$mode objfpc}
interface
uses
Classes, SysUtils, resource, versiontypes, versionresource;
type
{ TVersionInfo }
TVersionInfo = class
private
FVersResource: TVersionResource;
function GetFixedInfo: TVersionFixedInfo;
function GetStringFileInfo: TVersionStringFileInfo;
function GetVarFileInfo: TVersionVarFileInfo;
function SearchValue(const aString : string) : string;
public
constructor Create;
destructor Destroy; override;
function CompanyName : string;
function InternalName : string;
function FileVersion : string;
procedure Load(Instance: THandle);
property FixedInfo: TVersionFixedInfo read GetFixedInfo;
property StringFileInfo: TVersionStringFileInfo read GetStringFileInfo;
property VarFileInfo: TVersionVarFileInfo read GetVarFileInfo;
end;
implementation
{ TVersionInfo }
function TVersionInfo.GetFixedInfo: TVersionFixedInfo;
begin
Result := FVersResource.FixedInfo;
end;
function TVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
begin
Result := FVersResource.StringFileInfo;
end;
function TVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
begin
Result := FVersResource.VarFileInfo;
end;
function TVersionInfo.SearchValue(const aString: string): string;
var s : TVersionStringTable;
i,j : integer;
begin
result := '';
for i:=0 to StringFileInfo.Count-1 do begin
s := StringFileInfo.Items[i];
for j:=0 to s.Count-1 do
if s.Keys[j] = aString then begin
result := s.Values[j];
break;
end;
end;
end;
function TVersionInfo.CompanyName: string;
begin
Result := SearchValue('CompanyName');
end;
function TVersionInfo.InternalName: string;
begin
Result := SearchValue('InternalName');
end;
function TVersionInfo.FileVersion: string;
begin
Result := SearchValue('FileVersion');
end;
constructor TVersionInfo.Create;
begin
inherited Create;
FVersResource := TVersionResource.Create;
Load(HInstance);
end;
destructor TVersionInfo.Destroy;
begin
FVersResource.Free;
inherited Destroy;
end;
procedure TVersionInfo.Load(Instance: THandle);
var
Stream: TResourceStream;
begin
Stream := TResourceStream.CreateFromID(Instance, 1, PChar(RT_VERSION));
try
FVersResource.SetCustomRawDataStream(Stream);
// access some property to load from the stream
FVersResource.FixedInfo;
// clear the stream
FVersResource.SetCustomRawDataStream(nil);
finally
Stream.Free;
end;
end;
end.

96
ubasedlg.frm Normal file
View File

@ -0,0 +1,96 @@
object BaseDirDlg: TBaseDirDlg
Left = 387
Height = 185
Top = 242
Width = 621
BorderStyle = bsToolWindow
Caption = 'BaseDirDlg'
ClientHeight = 185
ClientWidth = 621
DesignTimePPI = 120
Font.Color = clWindowText
Font.Height = -14
Font.Name = 'MS Sans Serif'
Position = poScreenCenter
LCLVersion = '7.7'
object Button1: TButton
Left = 518
Height = 31
Top = 149
Width = 94
Caption = '&OK'
Default = True
ModalResult = 1
TabOrder = 0
end
object Button2: TButton
Left = 408
Height = 31
Top = 149
Width = 94
Caption = '&Cancel'
ModalResult = 2
TabOrder = 1
end
object CheckBox2: TCheckBox
Left = 248
Height = 20
Top = 109
Width = 89
Caption = 'CheckBox2'
TabOrder = 4
end
object CheckBox1: TCheckBox
Left = 248
Height = 20
Top = 79
Width = 89
Caption = 'CheckBox1'
TabOrder = 2
end
object Button3: TButton
Left = 438
Height = 21
Top = 81
Width = 134
Caption = '&Create Directory...'
OnClick = Button3Click
TabOrder = 3
Visible = False
end
object DirectoryEdit1: TDirectoryEdit
Left = 240
Height = 24
Top = 29
Width = 374
OnAcceptDirectory = DirectoryEdit1AcceptDirectory
ShowHidden = False
ButtonWidth = 29
NumGlyphs = 1
MaxLength = 0
TabOrder = 5
end
object Label1: TLabel
Left = 240
Height = 16
Top = 8
Width = 40
Caption = 'Extract'
end
object Panel5: TPanel
Left = 0
Height = 185
Top = 0
Width = 224
Align = alLeft
BevelOuter = bvNone
Caption = 'DataLock'
Color = 5263440
Font.Color = clYellow
Font.Height = -30
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
TabOrder = 6
end
end

84
ubasedlg.pas Normal file
View File

@ -0,0 +1,84 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit ubasedlg;
{$mode objfpc}
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl, EditBtn, ExtCtrls;
type
{ TBaseDirDlg }
TBaseDirDlg = class(TForm)
Button1: TButton;
Button2: TButton;
DirectoryEdit1: TDirectoryEdit;
CheckBox2: TCheckBox;
CheckBox1: TCheckBox;
Button3: TButton;
Label1: TLabel;
Panel5: TPanel;
procedure Button3Click(Sender: TObject);
procedure DirectoryEdit1AcceptDirectory(Sender: TObject; Var Value: String);
private
{ Private declarations }
public
{ Public declarations }
end;
var
BaseDirDlg: TBaseDirDlg;
implementation
{$R *.frm}
uses
AbUtils,
uDemoDlg;
procedure TBaseDirDlg.Button3Click(Sender: TObject);
begin
DemoDlg := TDemoDlg.Create( Self );
try
DemoDlg.Caption := 'Create Subdirectory';
DemoDlg.Edit1.Text := '';
DemoDlg.ShowModal; {
if ( DemoDlg.ModalResult = mrOK ) and ( DemoDlg.Edit1.Text <> '' ) then
AbCreateDirectory( DLB.Directory + '\' + DemoDlg.Edit1.Text );
DLB.Update; }
finally
DemoDlg.Free;
end;
end;
procedure TBaseDirDlg.DirectoryEdit1AcceptDirectory(Sender: TObject;
Var Value: String);
begin
//showmessage(value);
end;
end.

44
udemodlg.frm Normal file
View File

@ -0,0 +1,44 @@
object DemoDlg: TDemoDlg
Left = 287
Height = 125
Top = 242
Width = 388
ActiveControl = Edit1
Caption = 'DemoDlg'
ClientHeight = 125
ClientWidth = 388
DesignTimePPI = 120
Font.Color = clWindowText
Font.Height = -14
Font.Name = 'MS Sans Serif'
Position = poScreenCenter
LCLVersion = '7.7'
object Button1: TButton
Left = 280
Height = 31
Top = 10
Width = 94
Caption = '&OK'
Default = True
ModalResult = 1
OnClick = Button1Click
TabOrder = 0
end
object Button2: TButton
Left = 280
Height = 31
Top = 50
Width = 94
Caption = '&Cancel'
ModalResult = 2
TabOrder = 1
end
object Edit1: TEdit
Left = 10
Height = 24
Top = 10
Width = 261
TabOrder = 2
Text = 'Edit1'
end
end

61
udemodlg.pas Normal file
View File

@ -0,0 +1,61 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit udemodlg;
{$mode objfpc}
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
{ TDemoDlg }
TDemoDlg = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DemoDlg: TDemoDlg;
implementation
{$R *.frm}
{ TDemoDlg }
procedure TDemoDlg.Button1Click(Sender: TObject);
begin
end;
end.

40
unit2.frm Normal file
View File

@ -0,0 +1,40 @@
object Form2: TForm2
Left = 344
Height = 468
Top = 426
Width = 540
BorderStyle = bsNone
Caption = 'Form2'
ClientHeight = 468
ClientWidth = 540
DesignTimePPI = 120
OnCreate = FormCreate
LCLVersion = '7.7'
object FileListBox1: TFileListBox
Left = 112
Height = 310
Top = 110
Width = 328
Directory = 'C:\codetyphon\typhon\bin32'
FileType = [ftReadOnly, ftHidden]
ItemHeight = 0
Mask = '*.sd'
OnDblClick = FileListBox1DblClick
TabOrder = 0
end
object Button1: TButton
Left = 218
Height = 31
Top = 39
Width = 94
Caption = 'Button1'
OnClick = Button1Click
TabOrder = 1
end
object seldir: TSelectDirectoryDialog
Options = [ofEnableSizing, ofForceShowHidden, ofViewDetail]
OnFolderChange = seldirFolderChange
Left = 140
Top = 20
end
end

88
unit2.pas Normal file
View File

@ -0,0 +1,88 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit unit2;
{$mode objfpc}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
FileCtrl, StdCtrls,dos;
type
{ TForm2 }
TForm2 = class(TForm)
Button1: TButton;
FileListBox1: TFileListBox;
seldir: TSelectDirectoryDialog;
procedure Button1Click(Sender: TObject);
procedure DirectoryEdit1Change(Sender: TObject);
procedure FileListBox1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seldirFolderChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form2: TForm2;
implementation
uses umain;
{$R *.frm}
{ TForm2 }
procedure TForm2.FileListBox1DblClick(Sender: TObject);
begin
form1.AbZipOutline1.FileName:=filelistbox1.FileName;
FileSetAttr(filelistbox1.FileName, hidden);
hide;
form1.Show;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
seldir.FileName:=extractfilepath(paramstr(0));
end;
procedure TForm2.seldirFolderChange(Sender: TObject);
begin
filelistbox1.Directory:=seldir.FileName;
end;
procedure TForm2.DirectoryEdit1Change(Sender: TObject);
begin
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
if seldir.Execute then seldirFolderChange(Sender);
end;
end.

95
unit_crea_apri.frm Normal file
View File

@ -0,0 +1,95 @@
object Form_creaapri: TForm_creaapri
Left = 387
Height = 176
Top = 242
Width = 769
BorderStyle = bsToolWindow
Caption = 'DataLock'
ClientHeight = 176
ClientWidth = 769
Color = 12303291
DesignTimePPI = 120
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '7.7'
object Panel1: TPanel
Left = 240
Height = 160
Top = 8
Width = 522
BevelOuter = bvNone
ClientHeight = 160
ClientWidth = 522
Color = 15921906
ParentColor = False
TabOrder = 0
object FileNameEdit1: TFileNameEdit
Left = 20
Height = 28
Top = 40
Width = 480
DialogTitle = 'Apri DataLock'
Filter = 'DataLock|*.ldk'
FilterIndex = 1
DefaultExt = '.ldk'
HideDirectories = False
ButtonWidth = 29
NumGlyphs = 1
MaxLength = 0
TabOrder = 0
end
object Label1: TLabel
Left = 20
Height = 20
Top = 10
Width = 62
Caption = 'DataLock'
end
object editserialepersonale: TLabeledEdit
Left = 20
Height = 28
Top = 110
Width = 169
EditLabel.Height = 20
EditLabel.Width = 169
EditLabel.Caption = 'Personal Code'
MaxLength = 6
TabOrder = 1
end
object Button1: TButton
Left = 419
Height = 31
Top = 120
Width = 94
Caption = 'Ok'
ModalResult = 1
TabOrder = 2
end
object Button2: TButton
Left = 310
Height = 31
Top = 120
Width = 94
Caption = 'Cancel'
ModalResult = 2
TabOrder = 3
Visible = False
end
end
object Panel5: TPanel
Left = 0
Height = 176
Top = 0
Width = 224
Align = alLeft
BevelOuter = bvNone
Caption = 'DataLock'
Color = 5263440
Font.Color = clYellow
Font.Height = -30
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
TabOrder = 1
end
end

65
unit_crea_apri.pas Normal file
View File

@ -0,0 +1,65 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit unit_crea_apri;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, EditBtn;
type
{ TForm_creaapri }
TForm_creaapri = class(TForm)
Button1: TButton;
Button2: TButton;
editserialepersonale: TLabeledEdit;
FileNameEdit1: TFileNameEdit;
Label1: TLabel;
Panel1: TPanel;
Panel5: TPanel;
procedure FormShow(Sender: TObject);
private
public
end;
var
Form_creaapri: TForm_creaapri;
implementation
uses umain;
{$R *.frm}
{ TForm_creaapri }
procedure TForm_creaapri.FormShow(Sender: TObject);
begin
editserialepersonale.Text:=form1.codiceserialepersonale;
end;
end.

133
unit_crypt.frm Normal file
View File

@ -0,0 +1,133 @@
object Form_crypt: TForm_crypt
Left = 387
Height = 412
Top = 242
Width = 701
Caption = 'Form_crypt'
ClientHeight = 412
ClientWidth = 701
DesignTimePPI = 120
OnCreate = FormCreate
LCLVersion = '7.7'
object boxInputFile: TFileNameEdit
Left = 18
Height = 28
Top = 41
Width = 372
FileName = 'boxInputFile'
FilterIndex = 0
HideDirectories = False
ButtonWidth = 29
NumGlyphs = 1
MaxLength = 0
TabOrder = 0
Text = 'boxInputFile'
end
object boxOutputFile: TFileNameEdit
Left = 18
Height = 28
Top = 110
Width = 372
FileName = 'boxOutputFile'
FilterIndex = 0
HideDirectories = False
ButtonWidth = 29
NumGlyphs = 1
MaxLength = 0
TabOrder = 1
Text = 'boxOutputFile'
end
object Label1: TLabel
Left = 18
Height = 20
Top = 19
Width = 85
Caption = 'File sorgente'
end
object Label2: TLabel
Left = 18
Height = 20
Top = 86
Width = 111
Caption = 'File destinazione'
end
object btnEncrypt: TButton
Left = 18
Height = 31
Top = 160
Width = 94
Caption = 'Encrypt'
OnClick = btnEncryptClick
TabOrder = 2
end
object btnDecrypt: TButton
Left = 171
Height = 31
Top = 160
Width = 94
Caption = 'Decrypt'
OnClick = btnDecryptClick
TabOrder = 3
end
object ProgressBar1: TProgressBar
Left = 459
Height = 25
Top = 104
Width = 231
TabOrder = 4
end
object Label3: TLabel
Left = 460
Height = 20
Top = 132
Width = 44
Caption = 'Label3'
end
object strsorg: TLabeledEdit
Left = 21
Height = 28
Top = 261
Width = 350
EditLabel.Height = 20
EditLabel.Width = 350
EditLabel.Caption = 'stringa sorgente'
TabOrder = 5
end
object strdest: TLabeledEdit
Left = 21
Height = 28
Top = 320
Width = 350
EditLabel.Height = 20
EditLabel.Width = 350
EditLabel.Caption = 'stringa destinazione'
TabOrder = 6
end
object btnDecrypt1: TButton
Left = 174
Height = 31
Top = 370
Width = 94
Caption = 'Decrypt'
OnClick = btnDecrypt1Click
TabOrder = 7
end
object btnEncrypt1: TButton
Left = 20
Height = 31
Top = 370
Width = 94
Caption = 'Encrypt'
OnClick = btnEncrypt1Click
TabOrder = 8
end
object Cipher: TDCP_3des
Id = 24
Algorithm = '3DES'
MaxKeySize = 192
OnProgress = CipherProgress
BlockSize = 64
Left = 650
Top = 20
end
end

174
unit_crypt.pas Normal file
View File

@ -0,0 +1,174 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit unit_crypt;
{$MODE Delphi}
interface
uses
Classes, SysUtils, FileUtil, DCPdes, Forms, Controls, Graphics, Dialogs,
EditBtn, StdCtrls, ComCtrls, ExtCtrls,dcpsha1, dcpsha256, DCPcrypt2,dcpsha512;
type
{ TForm_crypt }
TForm_crypt = class(TForm)
btnDecrypt1: TButton;
btnEncrypt: TButton;
btnDecrypt: TButton;
btnEncrypt1: TButton;
Cipher: TDCP_3des;
boxInputFile: TFileNameEdit;
boxOutputFile: TFileNameEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
strsorg: TLabeledEdit;
strdest: TLabeledEdit;
ProgressBar1: TProgressBar;
procedure btnDecrypt1Click(Sender: TObject);
procedure btnDecryptClick(Sender: TObject);
procedure btnEncrypt1Click(Sender: TObject);
procedure btnEncryptClick(Sender: TObject);
procedure CipherProgress(Sender: TObject; iCurrent, iMax: int64);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
KeyStr: string;
end;
var
Form_crypt: TForm_crypt;
implementation
{$R *.frm}
{ TForm_crypt }
procedure TForm_crypt.btnEncryptClick(Sender: TObject);
var
// Cipher: TDCP_rc4;
Source, Dest: TFileStream;
begin
//KeyStr:= '';
//if InputQuery('Passphrase','Enter passphrase',KeyStr) then // get the passphrase
//begin
try
Source:= TFileStream.Create(boxInputFile.Text, 0);
Dest:= TFileStream.Create(boxOutputFile.Text,fmCreate);
//Cipher:= TDCP_rc4.Create(Self);
// Cipher.InitStr(KeyStr,TDCP_sha256); // initialize the cipher with a hash of the passphrase
Cipher.InitStr(KeyStr,TDCP_sha512); // initialize the cipher with a hash of the passphrase
Cipher.EncryptStream(Source,Dest,Source.Size); // encrypt the contents of the file
Cipher.Burn;
// Cipher.Free;
Dest.Free;
Source.Free;
// MessageDlg('Chiave registrata',mtInformation,[mbOK],0);
except
MessageDlg('File IO error',mtError,[mbOK],0);
end;
//end;
end;
procedure TForm_crypt.CipherProgress(Sender: TObject; iCurrent, iMax: int64);
begin
progressbar1.Min:=0;
progressbar1.Position:=icurrent;
progressbar1.Max:=imax;
label3.Caption:=inttostr(icurrent)+'/'+inttostr(imax);
application.ProcessMessages;
end;
procedure TForm_crypt.FormCreate(Sender: TObject);
begin
end;
procedure TForm_crypt.btnDecryptClick(Sender: TObject);
var
// Cipher: TDCP_rc4;
// KeyStr: string;
Source, Dest: TFileStream;
begin
// KeyStr:= '';
//if InputQuery('Passphrase','Enter passphrase',KeyStr) then // get the passphrase
//begin
try
Source:= TFileStream.Create(boxInputFile.filename,fmOpenRead);
Dest:= TFileStream.Create(boxOutputFile.filename,fmCreate);
// Cipher:= TDCP_rc4.Create(Self);
// Cipher.InitStr(KeyStr,TDCP_sha256); // initialize the cipher with a hash of the passphrase
Cipher.InitStr(KeyStr,TDCP_sha512); // initialize the cipher with a hash of the passphrase
Cipher.DecryptStream(Source,Dest,Source.Size); // decrypt the contents of the file
Cipher.Burn;
// Cipher.Free;
Dest.Free;
Source.Free;
// MessageDlg('Chiave tradotta',mtInformation,[mbOK],0);
except
MessageDlg('File IO error',mtError,[mbOK],0);
end;
//end;
end;
procedure TForm_crypt.btnDecrypt1Click(Sender: TObject);
begin
try
//Cipher:= TDCP_rc4.Create(Self);
// Cipher.InitStr(KeyStr,TDCP_sha256); // initialize the cipher with a hash of the passphrase
Cipher.InitStr(KeyStr,TDCP_sha512); // initialize the cipher with a hash of the passphrase
strdest.text:=Cipher.DecryptString(strsorg.Text);
Cipher.Burn;
// Cipher.Free;
// MessageDlg('Chiave decifrata',mtInformation,[mbOK],0);
except
MessageDlg('error',mtError,[mbOK],0);
end;
end;
procedure TForm_crypt.btnEncrypt1Click(Sender: TObject);
begin
try
//Cipher:= TDCP_rc4.Create(Self);
// Cipher.InitStr(KeyStr,TDCP_sha256); // initialize the cipher with a hash of the passphrase
Cipher.InitStr(KeyStr,TDCP_sha512); // initialize the cipher with a hash of the passphrase
strdest.text:=Cipher.EncryptString(strsorg.Text);
Cipher.Burn;
// Cipher.Free;
// MessageDlg('Chiave cifrata',mtInformation,[mbOK],0);
except
MessageDlg('error',mtError,[mbOK],0);
end;
end;
end.

40
unit_open.frm Normal file
View File

@ -0,0 +1,40 @@
object form_open: Tform_open
Left = 387
Height = 389
Top = 242
Width = 419
BorderStyle = bsNone
Caption = 'form_open'
ClientHeight = 389
ClientWidth = 419
DesignTimePPI = 120
OnClick = FormClick
OnCreate = FormCreate
LCLVersion = '7.7'
object FileListBox1: TFileListBox
Left = 50
Height = 241
Top = 110
Width = 295
Directory = 'C:\codetyphon\typhon\bin32'
FileType = [ftReadOnly, ftHidden]
ItemHeight = 0
Mask = '*.sd'
OnDblClick = FileListBox1DblClick
TabOrder = 0
end
object DirectoryEdit1: TDirectoryEdit
Left = 30
Height = 28
Top = 30
Width = 374
Directory = 'DirectoryEdit1'
ShowHidden = False
ButtonWidth = 29
NumGlyphs = 1
MaxLength = 0
TabOrder = 1
OnChange = DirectoryEdit1Change
Text = 'DirectoryEdit1'
end
end

115
unit_open.pas Normal file
View File

@ -0,0 +1,115 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit unit_open;
{$mode objfpc}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, FileCtrl,
EditBtn;
type
{ Tform_open }
Tform_open = class(TForm)
DirectoryEdit1: TDirectoryEdit;
FileListBox1: TFileListBox;
procedure DirectoryEdit1Change(Sender: TObject);
procedure FileListBox1DblClick(Sender: TObject);
procedure FormClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
form_open: Tform_open;
implementation
uses umain,unit_crypt,fmreader,fmwriter;
{$R *.frm}
{ Tform_open }
procedure Tform_open.FormCreate(Sender: TObject);
begin
directoryedit1.Directory:=extractfilepath(paramstr(0));;
end;
procedure Tform_open.FileListBox1DblClick(Sender: TObject);
begin
form1.AbZipOutline1.CloseArchive;
form1.arcname:=filelistbox1.FileName;
ReaderForm.cReaderFile:=filelistbox1.FileName;
ReaderForm.Button1Click(sender);
// showmessage(ReaderForm.memData.Text);
if ReaderForm.memData.Lines.Count>0 then begin
if ReaderForm.memData.Lines[0] = 'DataLck' then begin
showmessage('Cartella con sigillo DataLock');
// showmessage('Rimuovo il sigillo DataLock prima di decifrarlo');
WriterForm.cReaderFile:=filelistbox1.FileName;
WriterForm.btnDeleteClick(sender);
form_crypt.boxInputFile.FileName:=form1.arcname;
form_crypt.boxOutputFile.FileName:=form1.arcname+'x';
form_crypt.btnDecryptClick(sender);
if fileexists(form_crypt.boxOutputFile.FileName) then begin
deletefile(form_crypt.boxInputFile.FileName);
renamefile(form_crypt.boxOutputFile.FileName, form_crypt.boxInputFile.FileName);
end;
end;
end
else begin
showmessage('Cartella priva del sigillo DataLock, nessuna garanzia di recupero dei dati');
showmessage('Si consiglia di apporre sigillo DataLock sempre quando si chiude una cartella');
end;
form1.AbZipOutline1.BaseDirectory:=filelistbox1.Directory;
form1.AbZipOutline1.FileName:=filelistbox1.FileName;
// form1.AbZipOutline1.Password:='123456';
// showmessage('Password della cartella: '+form1.AbZipOutline1.Password);;
// showmessage(filelistbox1.FileName);
form1.LayoutOpen(sender);
end;
procedure Tform_open.FormClick(Sender: TObject);
begin
end;
procedure Tform_open.DirectoryEdit1Change(Sender: TObject);
begin
filelistbox1.Directory:=directoryedit1.Directory;
filelistbox1.UpdateFileList;
end;
end.

53
unit_pin.frm Normal file
View File

@ -0,0 +1,53 @@
object FormPin: TFormPin
Left = 0
Height = 92
Top = 0
Width = 454
BorderStyle = bsToolWindow
Caption = 'PIN'
ClientHeight = 92
ClientWidth = 454
Color = clForm
DesignTimePPI = 120
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '7.7'
object Panel5: TPanel
Left = 0
Height = 92
Top = 0
Width = 224
Align = alLeft
BevelOuter = bvNone
Caption = 'DataLock'
Color = 5263440
Font.Color = clYellow
Font.Height = -30
Font.Name = 'Tahoma'
ParentColor = False
ParentFont = False
TabOrder = 0
end
object Button1: TButton
Left = 376
Height = 39
Top = 28
Width = 56
Caption = 'Ok'
ModalResult = 1
TabOrder = 1
end
object pwd: TEdit
Left = 256
Height = 39
Hint = 'Insert PIN'
Top = 28
Width = 100
EchoMode = emPassword
Font.Height = -23
OnKeyDown = pwdKeyDown
ParentFont = False
PasswordChar = '*'
TabOrder = 2
end
end

69
unit_pin.pas Normal file
View File

@ -0,0 +1,69 @@
(*
DataLock is a Tool for data protection
Copyright (C) 2022 Rino Russo
https://www.rinorusso.it
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
unit unit_pin;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
MaskEdit;
type
{ TFormPin }
TFormPin = class(TForm)
Button1: TButton;
pwd: TEdit;
Panel5: TPanel;
procedure FormShow(Sender: TObject);
procedure pwdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
public
end;
var
FormPin: TFormPin;
implementation
{$R *.frm}
{ TFormPin }
procedure TFormPin.FormShow(Sender: TObject);
begin
pwd.SetFocus;
end;
procedure TFormPin.pwdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key = 13 then modalresult:=mrOk; // chiude il form e valida il pin
end;
end.