diff --git a/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.bpr b/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.bpr deleted file mode 100644 index a7981a1c41a..00000000000 --- a/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.bpr +++ /dev/null @@ -1,176 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = CheckCombo.exe -OBJFILES = Unit1.obj CheckCombo.obj -RESFILES = -DEFFILE = -RESDEPEN = $(RESFILES) Unit1.dfm -LIBFILES = -LIBRARIES = VCL35.lib -SPARELIBS = VCL35.lib -PACKAGES = -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -O2 -Hc -w -Ve -k- -vi -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl \ - -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -$L- -$D- -v \ - -JPHN -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 \ - /zn /d_RTLDLL /dUSEPACKAGES -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -aa -Tpe -x -Gn -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mt.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[HistoryLists\hlIncludePath] -Count=1 -Item0=$(BCB)\include;$(BCB)\include\vcl;E:\projects\ElPack\Code\Source - -[HistoryLists\hlLibraryPath] -Count=2 -Item0=..\..\elpack\lib;$(BCB)\lib\obj;$(BCB)\lib;E:\projects\ElPack\Code\Source -Item1=..\..\elpack\lib;$(BCB)\lib\obj;$(BCB)\lib - -[HistoryLists\hlDebugSourcePath] -Count=2 -Item0=$(BCB)\source\vcl;E:\projects\ElPack\Code\Source -Item1=$(BCB)\source\vcl - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl;E:\projects\ElPack\Code\Source - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.cpp b/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.cpp deleted file mode 100644 index 6a810670b1f..00000000000 --- a/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.cpp +++ /dev/null @@ -1,20 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USEFORMNS("Unit1.pas", Unit1, Form1); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->CreateForm(__classid(TForm1), &Form1); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.res b/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.res deleted file mode 100644 index 292d56b51aa..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/CheckCombo/CheckCombo.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/CheckCombo/Unit1.dfm b/sdk/components/ElPack/BCBDemos/CheckCombo/Unit1.dfm deleted file mode 100644 index 2039f73de85..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/CheckCombo/Unit1.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/CheckCombo/Unit1.pas b/sdk/components/ElPack/BCBDemos/CheckCombo/Unit1.pas deleted file mode 100644 index 65fe9157e05..00000000000 --- a/sdk/components/ElPack/BCBDemos/CheckCombo/Unit1.pas +++ /dev/null @@ -1,170 +0,0 @@ -unit Unit1; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ElTree, ElTools, StdCtrls, ElHeader, ElVCLUtils, ElTreeComboBox, - ElXPThemedControl, ElUxTheme, ElTmSchema; - -type - TForm1 = class(TForm) - Tree: TElTree; - InplaceCombo: TElTreeInplaceComboBox; - procedure FormShow(Sender: TObject); - procedure TreeItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); - procedure TreeClick(Sender: TObject); - procedure InplaceComboValidateResult(Sender: TObject; - var InputValid: Boolean); - procedure InplaceComboBeforeOperation(Sender: TObject; - var DefaultConversion: Boolean); - private - - public - { Public declarations } - end; - -var - Form1: TForm1; - -const EnumData : array[0..4] of string = ('1', '2', '3', '4','5'); - -type - PDataRec = ^TDataRec; - TDataRec = record - Checked : boolean; - ComboIdx : integer; - end; - -var DataRec : TDataRec; - -implementation - -{$R *.DFM} - -procedure TForm1.FormShow(Sender: TObject); -var TI : TElTreeItem; - CS : TElCellStyle; -begin - TI := Tree.Items[0]; - TI.UseStyles := true; - CS := TI.AddStyle; - CS.OwnerProps := true; - CS.Style := elhsOwnerDraw; - CS.CellType := sftEnum; - CS := TI.AddStyle; - CS.OwnerProps := true; - CS.Style := elhsOwnerDraw; - TI.Data := @DataRec; - DataRec.Checked := false; - DataRec.ComboIdx := 0; -end; - -procedure TForm1.TreeItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); -var R1 : TRect; - sid: integer; - ATheme: HTheme; -const CheckStates : array[boolean] of integer = (0, DFCS_CHECKED); -begin - Surface.Brush.Style := bsClear; - if SectionIndex = 1 then - begin - if Tree.IsThemeApplied then - begin - ATheme := OpenThemeData(Handle, 'COMBOBOX'); - if ATheme <> 0 then - begin - Dec(R.Right, 16); - DrawText(Surface.Handle, Pchar(EnumData[PDataRec(Item.Data).ComboIdx]), -1, R, DT_LEFT or DT_SINGLELINE or DT_VCENTER); - R.Left := R.Right; - R.Right := R.Right + 16; - - if PDataRec(Item.Data).Checked then - sid := CBS_CHECKEDNORMAL - else - sid := CBS_UNCHECKEDNORMAL; - DrawThemeBackground(ATheme, Surface.Handle, CP_DROPDOWNBUTTON, CBXS_NORMAL, R, @R); - CloseThemeData(ATheme); - exit; - end - end; - Dec(R.Right, 10); - DrawText(Surface.Handle, Pchar(EnumData[PDataRec(Item.Data).ComboIdx]), -1, R, DT_LEFT or DT_SINGLELINE or DT_VCENTER); - R.Left := R.Right; - R.Right := R.Right + 10; - - ElVCLUtils.DrawArrow(Surface, eadDown, R, clWindowText, true); - end else - if SectionIndex = 2 then - begin - ElTools.CenterRects(14, R.Right - R.Left, 14, R.Bottom - R.Top, R1); - OffsetRect(R1, R.Left, R.Top); - if Tree.IsThemeApplied then - begin - ATheme := OpenThemeData(Handle, 'BUTTON'); - if ATheme <> 0 then - begin - if PDataRec(Item.Data).Checked then - sid := CBS_CHECKEDNORMAL - else - sid := CBS_UNCHECKEDNORMAL; - DrawThemeBackground(ATheme, Surface.Handle, BP_CHECKBOX, sid, R1, @R); - CloseThemeData(ATheme); - exit; - end - end; - DrawFrameControl(Surface.Handle, R1, DFC_BUTTON, DFCS_BUTTONCHECK or CheckStates[PDataRec(Item.Data).Checked]); - end; -end; - -procedure TForm1.TreeClick(Sender: TObject); -var HS : integer; - Item : TElTreeItem; - ItemPart: TSTItemPart; - P : TPoint; - Data : PDataRec; -begin - GetCursorPos(P); - P := Tree.ScreenToClient(P); - Item := Tree.GetItemAt(P.x, P.Y, ItemPart, HS); - if HS = 2 then - begin - Data := PDataRec(Item.Data); - Data.Checked := not Data.Checked; - Item.RedrawItemPart(true, Tree.HeaderSections[HS].Left, Tree.HeaderSections[HS].Right); - end else - if HS = 1 then - begin - if P.X > Tree.HeaderSections[HS].Right -10 then - Tree.EditItem(Item, HS); - end; -end; - -procedure TForm1.InplaceComboValidateResult(Sender: TObject; - var InputValid: Boolean); -var comboBox : TCombobox; -begin - ComboBox := InplaceCombo.Editor; - if ComboBox.ItemIndex >= 0 then - PDataRec(InplaceCombo.Item.Data).ComboIdx := ComboBox.ItemIndex - else - InputValid := false; -end; - -procedure TForm1.InplaceComboBeforeOperation(Sender: TObject; - var DefaultConversion: Boolean); -var comboBox : TCombobox; - i : integer; -begin - ComboBox := InplaceCombo.Editor; - Combobox.Style := csDropDownList; - Combobox.Items.Clear; - for i := 0 to 4 do - Combobox.Items.Add(EnumData[i]); - ComboBox.ItemIndex := PDataRec(InplaceCombo.Item.Data).ComboIdx; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrows.res b/sdk/components/ElPack/BCBDemos/DskBrows/DskBrows.res deleted file mode 100644 index b369156c076..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrows.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.bpr b/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.bpr deleted file mode 100644 index c79b45893f9..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.bpr +++ /dev/null @@ -1,179 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = DskBrowser.exe -OBJFILES = DskBrowser.obj frmMain.obj frmSearch.obj -RESFILES = DskBrows.res -DEFFILE = -RESDEPEN = $(RESFILES) frmMain.dfm frmSearch.dfm -LIBFILES = -LIBRARIES = vclx35.lib VCL35.lib -SPARELIBS = VCL35.lib vclx35.lib -PACKAGES = -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -Od -Hc -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl \ - -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -$Y -$W -$O- \ - -v -JPHN -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 \ - /zd /d_RTLDLL -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -aa -Tpe -x -Gn -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mt.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[HistoryLists\hlIncludePath] -Count=1 -Item0=$(BCB)\include;$(BCB)\include\vcl;e:\projects\elpack\code\source - -[HistoryLists\hlLibraryPath] -Count=1 -Item0=..\..\code;$(BCB)\lib\obj;$(BCB)\lib;e:\projects\elpack\code\source - -[HistoryLists\hlDebugSourcePath] -Count=1 -Item0=$(BCB)\source\vcl - -[HistoryLists\hlConditionals] -Count=2 -Item0=_RTLDLL -Item1=_RTLDLL;USEPACKAGES - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.cpp b/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.cpp deleted file mode 100644 index 15e3c36156a..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.cpp +++ /dev/null @@ -1,23 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("DskBrows.res"); -USEFORM("frmMain.cpp", MainForm); -USEFORM("frmSearch.cpp", SearchForm); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->CreateForm(__classid(TMainForm), &MainForm); - Application->CreateForm(__classid(TSearchForm), &SearchForm); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.res b/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.res deleted file mode 100644 index 1993f343f7b..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/DskBrows/DskBrowser.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.cpp b/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.cpp deleted file mode 100644 index 0d3970be10b..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.cpp +++ /dev/null @@ -1,338 +0,0 @@ -//--------------------------------------------------------------------------- - -#include -#include -#include -#pragma hdrstop - -#include "frmMain.h" -//--------------------------------------------------------------------------- -#pragma package(smart_init) -#pragma link "ElTree" -#pragma link "ElXPThemedControl" -#pragma resource "*.dfm" -TMainForm *MainForm; -//--------------------------------------------------------------------------- -__fastcall TMainForm::TMainForm(TComponent* Owner) - : TForm(Owner) -{ -} -//--------------------------------------------------------------------------- -TCursor __fastcall TElDragObject::GetDragCursor(bool Accepted, int X, int Y) { - - if (typeid(Control) == typeid(TElTree)) { - if (((dynamic_cast< TElTree* >(Control))->GetItemAtY(Y) != NULL) || - (Accepted)) { - return (dynamic_cast< TElTree* >(Control))->DragCursor; - } - else { - return crNoDrop; - } - } - else { - return TDragControlObject::GetDragCursor(Accepted,X,Y); - } -} - -//--------------------------------------------------------------------------- -void __fastcall TMainForm::ExitBtnClick(TObject *Sender) -{ - MainForm->Close(); -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::FormCreate(TObject *Sender) -{ - LastSelected = NULL; - Hash = new TElHashList(); - Tree->IsUpdating = true; - FillRoots(); - Tree->IsUpdating = false; - Tree->DragImageMode = dimNever; -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::FullPathCBClick(TObject *Sender) -{ - Tree->HeaderSections->Item[0]->Visible = FullPathCB->Checked; -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeCompareItems(TObject *Sender, - TElTreeItem *Item1, TElTreeItem *Item2, int &res) -{ - AnsiString S1, S2; - - S1 = ""; - S2 = ""; - try { - if (Item1->ColumnText->Count > 0) { S1 = Item1->ColumnText->Strings[0]; } - } - catch (Exception &exception) { } - - try { - if (Item2->ColumnText->Count > 0) { S2 = Item2->ColumnText->Strings[0]; } - } - catch (Exception &exception) { } - - if (Item1->Bold) { - if (Item2->Bold) { - res = AnsiCompareText(S1, S2); - } - else { - res = -1; - } - } - else { - if (Item2->Bold) { - res = 1; - } - else { - res = AnsiCompareText(S1, S2); - } - } -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeDragDrop(TObject *Sender, TObject *Source, - int X, int Y) -{ - MessageBox(0, "Sorry, but moving a file is not implemented", "ElPack Demo", 0); -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeDragOver(TObject *Sender, TObject *Source, - int X, int Y, TDragState State, bool &Accept) -{ - TElTreeItem* TSI; - Accept = false; - if (typeid(Source) != typeid(TElDragObject)) { return; } - - TSI = dynamic_cast< TElTree* >(dynamic_cast(Source)->Control)->GetItemAtY(Y); - if ((TSI != NULL) && (!(TSI->IsUnder(ItemDragging))) ) { - Accept = true; - } -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeHeaderColumnClick(TObject *Sender, - int SectionIndex) -{ - - Tree->SortSection = SectionIndex; - switch ( SectionIndex ) { - case 0 : Tree->SortType = Eltree::stText; break; - case 1 : Tree->SortType = Eltree::stCustom; break; - case 2 : Tree->SortType = Eltree::stNumber; break; - case 3 : Tree->SortType = Eltree::stDate; break; - case 4 : Tree->SortType = Eltree::stTime; break; - } - if ((Tree->HeaderSections->Item[SectionIndex])->SortMode == hsmAscend) { - (Tree->HeaderSections->Item[SectionIndex])->SortMode = hsmDescend; - } - else { - (Tree->HeaderSections->Item[SectionIndex])->SortMode = hsmAscend; - } - if (LastSelected != NULL) { - LastSelected->Sort(false); - } - else { - Tree->Sort(false); - } -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeItemCollapse(TObject *Sender, - TElTreeItem *Item) -{ - Tree->IsUpdating = true; - Item->Clear(); - LastSelected = Item->Parent; - Tree->IsUpdating = false; -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeItemExpand(TObject *Sender, - TElTreeItem *Item) -{ - - Tree->IsUpdating = true; - FillTree(Item, Item->ColumnText->Strings[0]); - LastSelected = Item; - Tree->IsUpdating = false; -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeItemExpanding(TObject *Sender, - TElTreeItem *Item, bool &CanProcess) -{ - -TSearchRec SRec; - AnsiString s; - - s = Item->ColumnText->Strings[0]; -// if (s[s.Length()] != '\\') { s = s + '\\'; } - if (AnsiLastChar(s) != "\\") { s = s + "\\"; } - s = s + "*.*"; -// FillChar(SRec, sizeof(SRec), #0); - CanProcess = (FindFirst(s, faAnyFile, SRec) == 0); - FindClose(SRec); - -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeKeyUp(TObject *Sender, WORD &Key, - TShiftState Shift) -{ - if (Key == VK_DELETE) { - MessageBox(0, "Sorry, but deleting a file is not implemented", - "ElPack Demo", 0); - } -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeStartDrag(TObject *Sender, - TDragObject *&DragObject) -{ - ItemDragging = Tree->ItemFocused; - DragObject = new TElDragObject(Tree); - -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::TreeValidateInplaceEdit(TObject *Sender, - TElTreeItem *Item, TElHeaderSection *Section, AnsiString &Text, - bool &Accept) -{ - - MessageBox(0, "Sorry, renaming a file is not implemented","ElPack Demo", 0); - Accept = false; - -} -//--------------------------------------------------------------------------- - -void __fastcall TMainForm::FillTree(TElTreeItem* Item, AnsiString Path) { - - TSearchRec SRec; - TElTreeItem* TSI; - bool b; - AnsiString s, FName; - int hn; - HICON IconHandle; - char* p; - TSHFileInfo SHFI; - TIcon* Icon ; - - - s = Path; - - if (*(s.AnsiLastChar()) != '\\') { s = s + "\\"; } - b = (FindFirst(s+"*.*", faAnyFile, SRec) == 0); - while (b) { - if ( (strcmp(SRec.FindData.cFileName,".") != 0) && - (strcmp(SRec.FindData.cFileName,"..") != 0) ) { - TSI = Tree->Items->AddItem(Item); - TSI->Text = SRec.FindData.cFileName; - FName = s + SRec.FindData.cFileName; - TSI->ColumnText->Add(FName); - TSI->ColumnText->Add(IntToStr(SRec.Size)); - TSI->ColumnText->Add(DateToStr(FileDateToDateTime(SRec.Time))); - TSI->ColumnText->Add(TimeToStr(FileDateToDateTime(SRec.Time))); - if ((faDirectory & SRec.Attr)>0) { - TSI->ParentStyle = false; - TSI->Bold = true; - TSI->ForceButtons = true; - } - if ((faHidden & SRec.Attr)>0) { - TSI->ParentStyle = false; - TSI->Italic = true; - TSI->ParentColors = false; - TSI->Color = clGray; - TSI->BkColor = Tree->BkColor; - TSI->UseBkColor = false; - } - if ((FILE_ATTRIBUTE_COMPRESSED & SRec.FindData.dwFileAttributes) > 0) { - TSI->ParentColors = false; - TSI->Color = clBlue; - TSI->BkColor = Tree->BkColor; - TSI->UseBkColor = false; - } -// GetMem(p, 260); - p = (char *) malloc(260); - StrPCopy(p, FName); - SHGetFileInfo(p, 0, &SHFI, sizeof(SHFI), 0x400 | 0x200 | 0x100 | 4 | 1); - IconHandle = SHFI.hIcon; - if (IconHandle != 0) { - hn = Hash->GetIndex(SHFI.szTypeName); - if ((hn == -1) || - (strcmp(SHFI.szTypeName,"Application")==0) || - (strcmp(SHFI.szTypeName,"Icon")==0)) { - Icon = new TIcon(); - Icon->Handle = IconHandle; - TSI->ImageIndex = Images->AddIcon(Icon); - Hash->AddItem(SHFI.szTypeName, &(TSI->ImageIndex)); - } - else { - TSI->ImageIndex = *((int *) Hash->GetByIndex(hn)); - } - TSI->StateImageIndex = TSI->ImageIndex; - } - free(p); - } - b = (FindNext(SRec) == 0); - } - FindClose(SRec); -} - - -void __fastcall TMainForm::FillRoots() -{ - TElTreeItem* TSI; - DWORD DrivesMask; - AnsiString s; - TIcon* Icon; - HICON IconHandle; - char* p; - TSHFileInfo SHFI; - - DrivesMask = GetLogicalDrives(); - for (int i=0; i < 25; i++ ) { - if (((DrivesMask >> i) % 2) == 1) { - - s = char(i+65); - s = s+":"; - TSI = Tree->Items->AddItem(NULL); - TSI->ParentStyle = false; - TSI->Bold = true; - TSI->ColumnText->Add(s+"\\"); - TSI->ForceButtons = true; -// GetMem(p, 260); - p = (char *) malloc(260); - StrPCopy(p, s+"\\"); - SHGetFileInfo(p, 0, &SHFI, sizeof(SHFI), 0x400 | 0x200 | 0x100 | 4 | 1); - IconHandle = SHFI.hIcon; - if ( IconHandle != 0 ) { - Icon = new TIcon(); - Icon->Handle = IconHandle; - TSI->ImageIndex = Images->AddIcon(Icon); - TSI->StateImageIndex = TSI->ImageIndex; -// Icon->Free; - } - free(p); - if (strlen(SHFI.szDisplayName)>0) { - s = StrPas(SHFI.szDisplayName); - } - TSI->Text = s; - } - } -} - - -void __fastcall TMainForm::TreeShowLineHint(TObject *Sender, - TElTreeItem *Item, TElFString &Text, THintWindow *HintWindow, - tagPOINT &MousePos, bool &DoShowHint) -{ - Text = Item->ColumnText->Strings[0]; -} -//--------------------------------------------------------------------------- - diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.dfm b/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.dfm deleted file mode 100644 index 3649b01768f..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.h b/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.h deleted file mode 100644 index 45549ca012f..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.h +++ /dev/null @@ -1,76 +0,0 @@ -//--------------------------------------------------------------------------- - -#ifndef frmMainH -#define frmMainH -//--------------------------------------------------------------------------- -#include -#include -#include -#include -#include "ElTree.hpp" -#include -#include -#include "ElXPThemedControl.h" -#include -#include "ElHashList.hpp" -//--------------------------------------------------------------------------- -using namespace std; - -class TMainForm : public TForm -{ -__published: // IDE-managed Components - TElTree *Tree; - TButton *Button1; - TButton *ExitBtn; - TImageList *Images; - TCheckBox *FullPathCB; - void __fastcall ExitBtnClick(TObject *Sender); - void __fastcall FormCreate(TObject *Sender); - void __fastcall FullPathCBClick(TObject *Sender); - void __fastcall TreeCompareItems(TObject *Sender, - TElTreeItem *Item1, TElTreeItem *Item2, int &res); - void __fastcall TreeDragDrop(TObject *Sender, TObject *Source, - int X, int Y); - void __fastcall TreeDragOver(TObject *Sender, TObject *Source, - int X, int Y, TDragState State, bool &Accept); - void __fastcall TreeHeaderColumnClick(TObject *Sender, - int SectionIndex); - void __fastcall TreeItemCollapse(TObject *Sender, - TElTreeItem *Item); - void __fastcall TreeItemExpand(TObject *Sender, TElTreeItem *Item); - void __fastcall TreeItemExpanding(TObject *Sender, - TElTreeItem *Item, bool &CanProcess); - void __fastcall TreeKeyUp(TObject *Sender, WORD &Key, - TShiftState Shift); - void __fastcall TreeStartDrag(TObject *Sender, - TDragObject *&DragObject); - void __fastcall TreeValidateInplaceEdit(TObject *Sender, - TElTreeItem *Item, TElHeaderSection *Section, AnsiString &Text, - bool &Accept); - void __fastcall TreeShowLineHint(TObject *Sender, TElTreeItem *Item, - TElFString &Text, THintWindow *HintWindow, tagPOINT &MousePos, - bool &DoShowHint); -private: // User declarations - TElTreeItem* LastSelected; - TElTreeItem* ItemDragging; - TElHashList* Hash; - -public: // User declarations - __fastcall TMainForm(TComponent* Owner); - void __fastcall FillRoots(); - void __fastcall FillTree(TElTreeItem* Item, AnsiString Path); - -}; - -class TElDragObject : public TDragControlObject { - protected: - TCursor __fastcall GetDragCursor(bool Accepted, int X, int Y); - public: - __fastcall TElDragObject(TControl* AControl) : TDragControlObject(AControl) { } - -}; - -//--------------------------------------------------------------------------- -extern PACKAGE TMainForm *MainForm; -//--------------------------------------------------------------------------- -#endif diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.pas b/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.pas deleted file mode 100644 index 5abdaf5521b..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/frmMain.pas +++ /dev/null @@ -1,342 +0,0 @@ -{$Q-} -{$RANGECHECKS OFF} -unit frmMain; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElTree, ElHashList, ShellApi, ElStrUtils, - {$IFDEF VER120} - ImgList, - {$ENDIF} - ElHeader, ElXPThemedControl; - -type - TMainForm = class(TForm) - Tree: TElTree; - ExitBtn: TButton; - FullPathCB: TCheckBox; - Images: TImageList; - Button1: TButton; - procedure ExitBtnClick(Sender: TObject); - procedure FullPathCBClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure TreeItemExpand(Sender: TObject; Item: TElTreeItem); - procedure TreeItemCollapse(Sender: TObject; Item: TElTreeItem); - procedure TreeItemExpanding(Sender: TObject; Item: TElTreeItem; - var CanProcess: Boolean); - procedure TreeHeaderColumnClick(Sender: TObject; - SectionIndex: Integer); - procedure TreeCompareItems(Sender: TObject; Item1, Item2: TElTreeItem; - var res: Integer); - procedure TreeStartDrag(Sender: TObject; var DragObject: TDragObject); - procedure TreeDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); - procedure TreeDragDrop(Sender, Source: TObject; X, Y: Integer); - procedure TreeKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure TreeValidateInplaceEdit(Sender: TObject; Item: TElTreeItem; Section : TElHeaderSection; - var Text: String; var Accept: Boolean); - procedure Button1Click(Sender: TObject); - procedure TreeShowLineHint(Sender: TObject; Item: TElTreeItem; - var Text: TElFString; HintWindow: THintWindow; MousePos: TPoint; - var DoShowHint: Boolean); - private - LastSelected, ItemDragging : TElTreeItem; - Hash : TElHashList; - { Private declarations } - public - { Public declarations } - procedure FillRoots; - procedure FillTree(Item:TElTreeItem; Path : string); - end; - -var - MainForm: TMainForm; - -type TElDragObject = class (TDragControlObject) - function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override; - end; - -implementation - -{$R *.DFM} - -procedure TMainForm.ExitBtnClick(Sender: TObject); -begin - Close; -end; - -procedure TMainForm.FillTree; -var SRec : TSearchRec; - TSI : TElTreeItem; - b : boolean; - s, FName : string; - hn : integer; - Icon : TIcon; - IconHandle : HICON; - p : pchar; - SHFI : TSHFileInfo; - -begin - s:=Path; - if s[length(s)]<>'\' then s:=s+'\'; - b:=(FindFirst(s+'*.*', faAnyFile, SRec) = 0); - while b do - begin - if (strcomp(SRec.FindData.cFileName,'.')<>0) and (strcomp(SRec.FindData.cFileName,'..')<>0) then - begin - TSI:=Tree.Items.AddItem(Item); - TSI.Text:=SRec.FindData.cFileName; - FName := s+ SRec.FindData.cFileName; - //hn:=TSI.Parent.ChildrenCount; - TSI.ColumnText.Add(FName); - TSI.ColumnText.Add(IntToStr(SRec.Size)); - TSI.ColumnText.Add(DateToStr(FileDateToDateTime(SRec.Time))); - TSI.ColumnText.Add(TimeToStr(FileDateToDateTime(SRec.Time))); - if (faDirectory AND SRec.Attr)>0 then - begin - TSI.ParentStyle := false; - TSI.Bold := true; - TSI.ForceButtons:=true; - end; - if (faHidden AND SRec.Attr)>0 then - begin - TSI.ParentStyle := false; - TSI.Italic := true; - TSI.ParentColors:=false; - TSI.Color := clGray; - TSI.BkColor := Tree.BkColor; - TSI.UseBkColor := false; - end; - if (FILE_ATTRIBUTE_COMPRESSED AND SRec.FindData.dwFileAttributes) >0 then - begin - TSI.ParentColors:=false; - TSI.Color := clBlue; - TSI.BkColor := Tree.BkColor; - end; - GetMem(p, 260); - StrPCopy(p, FName); - SHGetFileInfo(p, 0, SHFI, SizeOf(SHFI), $400 or $200 or $100 or 4 or 1); - IconHandle:=SHFI.hIcon; - if IconHandle<>0 then - begin - hn := Hash.GetIndex(SHFI.szTypeName); - if (hn = -1) or (strcomp(SHFI.szTypeName,'Application')=0) or (strcomp(SHFI.szTypeName,'Icon')=0) then - begin - Icon:=TIcon.Create; - Icon.Handle:=IconHandle; - TSI.ImageIndex:=Images.AddIcon(Icon); - Icon.Free; - Hash.AddItem(SHFI.szTypeName, pointer (TSI.ImageIndex)); - end else TSI.ImageIndex:=integer(Hash.GetByIndex(hn)); - TSI.StateImageIndex:=TSI.ImageIndex; - end; - FreeMem(p); - end; - b:=(FindNext(SRec) = 0); - end; - FindClose(SRec); -end; - -procedure TMainForm.FillRoots; -var TSI : TElTreeItem; - DrivesMask : DWORD; - i : integer; - s : string; - Icon : TIcon; - IconHandle : HICON; - p : pchar; - SHFI : TSHFileInfo; - -begin - DrivesMask := GetLogicalDrives; - for I:=0 to 25 do - begin - if ((DrivesMask shr i) mod 2) = 1 then - begin - s:=chr(i+65)+':'; - TSI:=Tree.Items.AddItem(nil); - TSI.ParentStyle:=false; - TSI.Bold:=true; - TSI.ColumnText.Add(s+'\'); - TSI.ForceButtons := true; - GetMem(p, 260); - StrPCopy(p, s+'\'); - SHGetFileInfo(p, 0, SHFI, SizeOf(SHFI), $400 or $200 or $100 or 4 or 1); - IconHandle:=SHFI.hIcon; - if IconHandle<>0 then - begin - Icon:=TIcon.Create; - Icon.Handle:=IconHandle; - TSI.ImageIndex:=Images.AddIcon(Icon); - TSI.StateImageIndex:=TSI.ImageIndex; - Icon.Free; - end; - FreeMem(p); - if strlen(SHFI.szDisplayName)>0 then s := StrPas(SHFI.szDisplayName); - TSI.Text := s; - end; - end; -end; - -procedure TMainForm.FullPathCBClick(Sender: TObject); -begin - Tree.HeaderSections.Item[0].Visible:=FullPathCB.Checked; -end; - -procedure TMainForm.FormCreate(Sender: TObject); -begin - LastSelected := nil; - Hash := TElHashList.Create; - Tree.IsUpdating:=true; - FillRoots; - Tree.IsUpdating:=false; - Tree.DragImageMode := dimNever; -end; - -procedure TMainForm.TreeItemExpand(Sender: TObject; Item: TElTreeItem); -begin - Tree.IsUpdating:=true; - FillTree(Item, Item.ColumnText[0]); - LastSelected:=Item; - Tree.IsUpdating:=false; -end; - -procedure TMainForm.TreeItemCollapse(Sender: TObject; Item: TElTreeItem); -begin - Tree.IsUpdating:=true; - Item.Clear; - LastSelected:=Item.Parent; - Tree.IsUpdating:=false; -end; - -procedure TMainForm.TreeItemExpanding(Sender: TObject; Item: TElTreeItem; - var CanProcess: Boolean); - -var SRec : TSearchRec; - s : string; - -begin -// Tree.HeaderSections.SectionsOrder := 'i0:w100:vf;i1:w120:vt;i4:w60:vt;i3:w80:vt;i2:w80:vt'; - s:=Item.ColumnText[0]; - if s[length(s)]<>'\' then s:=s+'\'; - s:=s+'*.*'; - FillChar(SRec, sizeof(SRec), #0); - CanProcess:=(FindFirst(s, faAnyFile, SRec) = 0); - FindClose(SRec); -end; - -procedure TMainForm.TreeHeaderColumnClick(Sender: TObject; - SectionIndex: Integer); -begin - Tree.SortSection:=SectionIndex; - case SectionIndex of - 0: Tree.SortType := stText; - 1: Tree.SortType := stCustom; - 2: Tree.SortType := stNumber; - 3: Tree.SortType := stDate; - 4: Tree.SortType := stTime; - end; - if Tree.HeaderSections[SectionIndex].SortMode=hsmAscend then - Tree.HeaderSections[SectionIndex].SortMode:=hsmDescend else - Tree.HeaderSections[SectionIndex].SortMode:=hsmAscend; - if LastSelected <> nil then LastSelected.Sort(false) else Tree.Sort(false); -end; - -procedure TMainForm.TreeCompareItems(Sender: TObject; Item1, - Item2: TElTreeItem; var res: Integer); -var S1, S2 : string; -begin - S1 := ''; - S2 := ''; - try - if Item1.ColumnText.Count>0 then S1:=Item1.ColumnText[0]; - except - on E:Exception do ; - end; - try - if Item2.ColumnText.Count>0 then S2:=Item2.ColumnText[0]; - except - on E:Exception do ; - end; - If Item1.Bold then - begin - if Item2.Bold then - begin - res:=AnsiCompareText(S1, S2); - end else res:=-1; - end else - if item2.Bold then res:=1 else - begin - res:=AnsiCompareText(S1, S2); - end; -end; - -procedure TMainForm.TreeStartDrag(Sender: TObject; - var DragObject: TDragObject); -begin - ItemDragging := Tree.ItemFocused; - DragObject:=TElDragObject.Create(Tree); -end; - -procedure TMainForm.TreeDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); -var TSI:TElTreeItem; -begin - Accept:=false; - if not (Source is TElDragObject) then exit; - TSI := ((Source as TElDragObject).Control as TElTree).GetItemAtY(Y); - if (TSI<>nil) and (not TSI.IsUnder(ItemDragging)) then - Accept:=true; -end; - -function TElDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; -begin - if Control is TElTree then - begin - if ((Control as TElTree).GetItemAtY(Y)<>nil) or (Accepted) then - Result := (Control as TElTree).DragCursor else - Result := crNoDrop; - end else result:=inherited GetDragCursor(Accepted,X,Y); -end; - - -procedure TMainForm.TreeDragDrop(Sender, Source: TObject; X, Y: Integer); -begin - MessageBox(0, 'Sorry, but moving a file is not implemented','ElPack Demo', 0); -end; - -procedure TMainForm.TreeKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - if Key = VK_DELETE then MessageBox(0, 'Sorry, but deleting a file is not implemented','ElPack Demo', 0); -end; - -procedure TMainForm.TreeValidateInplaceEdit(Sender: TObject; - Item: TElTreeItem; Section : TElHeaderSection; var Text: String; var Accept: Boolean); -begin - MessageBox(0, 'Sorry, renaming a file is not implemented','ElPack Demo', 0); - Accept:=false; -end; - -procedure TMainForm.Button1Click(Sender: TObject); -begin -(* - if SearchForm = nil then - SearchForm := TSearchForm.Create(nil); - SearchForm.Show; - SearchForm.BringToFront; -*) -end; - -procedure TMainForm.TreeShowLineHint(Sender: TObject; Item: TElTreeItem; - var Text: TElFString; HintWindow: THintWindow; MousePos: TPoint; - var DoShowHint: Boolean); -begin - Text:=Item.ColumnText[0]; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmSeach.dfm b/sdk/components/ElPack/BCBDemos/DskBrows/frmSeach.dfm deleted file mode 100644 index d07debdd56f..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/DskBrows/frmSeach.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmSeach.pas b/sdk/components/ElPack/BCBDemos/DskBrows/frmSeach.pas deleted file mode 100644 index b33a0c923b4..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/frmSeach.pas +++ /dev/null @@ -1,40 +0,0 @@ -unit frmSeach; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, - Dialogs, ElTree, StdCtrls; - -type - TSearchForm = class(TForm) - SearchBtn: TButton; - CloseBtn: TButton; - Label1: TLabel; - FieldCombo: TComboBox; - ActionCombo: TComboBox; - DataEdit: TEdit; - procedure CloseBtnClick(Sender: TObject); - private - { Private declarations } - public - Tree : TElTree; - end; - -var - SearchForm: TSearchForm; - -implementation - -{$R *.DFM} - -procedure TSearchForm.CloseBtnClick(Sender: TObject); -begin - Close; -end; - -initialization - SearchForm := nil; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.cpp b/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.cpp deleted file mode 100644 index 40bc7d91bdd..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.cpp +++ /dev/null @@ -1,23 +0,0 @@ -//--------------------------------------------------------------------------- - -#include -#pragma hdrstop - -#include "frmSearch.h" -//--------------------------------------------------------------------------- -#pragma package(smart_init) -#pragma resource "*.dfm" - -TSearchForm *SearchForm; -//--------------------------------------------------------------------------- -__fastcall TSearchForm::TSearchForm(TComponent* Owner) - : TForm(Owner) -{ -} -//--------------------------------------------------------------------------- -void __fastcall TSearchForm::CloseBtnClick(TObject *Sender) -{ - SearchForm->Close(); -} -//--------------------------------------------------------------------------- - diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.dfm b/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.dfm deleted file mode 100644 index fb7788297ab..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.h b/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.h deleted file mode 100644 index 0673a9894af..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/frmSearch.h +++ /dev/null @@ -1,28 +0,0 @@ -//--------------------------------------------------------------------------- - -#ifndef SearchH -#define SearchH -//--------------------------------------------------------------------------- -#include -#include -#include -#include -//--------------------------------------------------------------------------- -class TSearchForm : public TForm -{ -__published: // IDE-managed Components - TLabel *Label1; - TComboBox *FieldCombo; - TComboBox *ActionCombo; - TEdit *DataEdit; - TButton *SearchBtn; - TButton *CloseBtn; - void __fastcall CloseBtnClick(TObject *Sender); -private: // User declarations -public: // User declarations - __fastcall TSearchForm(TComponent* Owner); -}; -//--------------------------------------------------------------------------- -extern PACKAGE TSearchForm *SearchForm; -//--------------------------------------------------------------------------- -#endif diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmSelForm.dfm b/sdk/components/ElPack/BCBDemos/DskBrows/frmSelForm.dfm deleted file mode 100644 index 13ded2d17bd..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/DskBrows/frmSelForm.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/DskBrows/frmSelForm.pas b/sdk/components/ElPack/BCBDemos/DskBrows/frmSelForm.pas deleted file mode 100644 index 3c71b5dfc68..00000000000 --- a/sdk/components/ElPack/BCBDemos/DskBrows/frmSelForm.pas +++ /dev/null @@ -1,26 +0,0 @@ -unit frmSelForm; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls; - -type - TSelForm = class(TForm) - SelLB: TListBox; - private - { Private declarations } - public - { Public declarations } - end; - -var - SelForm: TSelForm; - -implementation - -{$R *.DFM} - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.bpr b/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.bpr deleted file mode 100644 index b37daa73e53..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.bpr +++ /dev/null @@ -1,159 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = ElAppBarDemo.exe -OBJFILES = frmMain.obj frmOpts.obj ElAppBarDemo.obj -RESFILES = ElAppBarDemo.res -DEFFILE = -RESDEPEN = $(RESFILES) frmMain.dfm frmOpts.dfm -LIBFILES = -LIBRARIES = -SPARELIBS = VCL35.lib -PACKAGES = -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -Od -Hc -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -$Y -$W -$O- -v -JPHN \ - -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /d_RTLDLL /dUSEPACKAGES /mx /w2 /zd -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) -aa -Tpe -x -Gn -v -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj $(PACKAGES) sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.cpp b/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.cpp deleted file mode 100644 index 65d4f0738d6..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.cpp +++ /dev/null @@ -1,24 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("ElAppBarDemo.res"); -USEFORMNS("frmMain.pas", Frmmain, frmBar); -USEFORMNS("frmOpts.pas", Frmopts, OptionsForm); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->Title = "ElAppBar Demo"; - Application->CreateForm(__classid(TfrmBar), &frmBar); - Application->CreateForm(__classid(TOptionsForm), &OptionsForm); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.res b/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.res deleted file mode 100644 index b369156c076..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElAppBar/ElAppBarDemo.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElAppBar/frmMain.dfm b/sdk/components/ElPack/BCBDemos/ElAppBar/frmMain.dfm deleted file mode 100644 index 7c5548a5388..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElAppBar/frmMain.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElAppBar/frmMain.pas b/sdk/components/ElPack/BCBDemos/ElAppBar/frmMain.pas deleted file mode 100644 index 635eb1e53bb..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElAppBar/frmMain.pas +++ /dev/null @@ -1,137 +0,0 @@ -unit frmMain; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElACtrls, ElSpin, ExtCtrls, ElPanel, ElClock, ElBtnCtl, - ElPopBtn, ElAppBar, Menus, ElToolBar, ElXPThemedControl; - -type - TfrmBar = class(TElAppBar) - LeftImage: TImage; - TopImage: TImage; - PopupMenu1: TPopupMenu; - miExit: TMenuItem; - ElToolBar1: TElToolBar; - ElClock1: TElClock; - btnOptions: TElPopupButton; - procedure miExitClick(Sender: TObject); - procedure btnOptionsClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - private - procedure EdgeChange(Sender : TObject); - protected - procedure CreateParams(var Params: TCreateParams); override; - procedure WMNcHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST; - public - end; - -var - frmBar: TfrmBar; - -implementation - -uses frmOpts; - -{$R *.DFM} - -procedure TfrmBar.WMNcHitTest(var Msg : TWMNCHitTest); -var p : TPoint; -begin - inherited; - p := ScreenToClient(SmallPointToPoint(Msg.Pos)); - if PtInRect(LeftImage.BoundsRect, p) or PtInRect(TopImage.BoundsRect, p) then - Msg.result := HTCaption; -end; - -procedure TfrmBar.EdgeChange; -begin - if Edge in [abeLeft, abeRight] then - begin - EltoolBar1.Orientation := eboVert; - LeftImage.Visible := false; - TopImage.Visible := true; - end else - begin - EltoolBar1.Orientation := eboHorz; - LeftImage.Visible := true; - TopImage.Visible := false; - end; -end; - -procedure TfrmBar.miExitClick(Sender: TObject); -begin - Close; -end; - -procedure TfrmBar.btnOptionsClick(Sender: TObject); -var aEdges : TAppBarFlags; -begin - with OptionsForm do - begin - LeftCB.Enabled := Edge <> abeLeft; - LeftCB.checked := abfAllowLeft in Flags; - - RightCB.Enabled := Edge <> abeRight; - RightCB.checked := abfAllowRight in Flags; - - TopCB.Enabled := Edge <> abeTop; - TopCB.checked := abfAllowTop in Flags; - - BottomCB.Enabled := Edge <> abeBottom; - BottomCB.Checked := abfAllowBottom in Flags; - - FloatingCB.Enabled := Edge <> abeFloat; - FloatingCB.Checked := abfAllowFloat in Flags; - - KeepSizeCB.Checked := KeepSize; - AutohideCB.Checked := AutoHide; - TopmostCB.Checked := AlwaysOnTop; - OnScreenCB.Checked := PreventOffScreen; - TaskBarCB.Checked := TaskEntry <> abtHide; - end; - if OptionsForm.ShowModal = mrOk then - with OptionsForm do - begin - aEdges := []; - - if LeftCB.Checked then include(aEdges, abfAllowLeft); - if RightCB.Checked then include(aEdges, abfAllowRight); - if TopCB.Checked then include(aEdges, abfAllowTop); - if BottomCB.Checked then include(aEdges, abfAllowBottom); - if FloatingCB.Checked then include(aEdges, abfAllowFloat); - - Flags := aEdges; - KeepSize := KeepSizeCB.Checked; - AutoHide := AutohideCB.Checked; - AlwaysOnTop := TopmostCB.Checked; - PreventOffScreen := OnScreenCB.Checked; - if TaskBarCB.Checked then TaskEntry := abtShow else TaskEntry := abtHide; - end; -end; - -procedure TfrmBar.FormCreate(Sender: TObject); -var r : TRect; - hb, vb : integer; -begin - OnEdgeChanged := EdgeChange; - hb := Width - ClientWidth; - vb := Height - ClientHeight; - r.Left := ElToolBar1.BtnWidth + ElToolBar1.BtnOffsHorz * 2 + hb; - r.Right := ElToolBar1.BtnWidth + ElToolBar1.BtnOffsHorz * 2 + hb; - r.Top := ElToolBar1.BtnHeight + ElToolBar1.BtnOffsVert * 2 + vb; - r.Bottom := ElToolBar1.BtnHeight + ElToolBar1.BtnOffsVert * 2 + vb; - DockDims := r; -end; - -procedure TFrmBar.CreateParams(var Params: TCreateParams); -begin - inherited; - Params.Style := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_THICKFRAME; - // WS_EX_TOOLWINDOW is MANDATORY, otherwise everything stops working!!!!!!!!!!! - Params.ExStyle := Params.ExStyle or WS_EX_CONTROLPARENT or WS_EX_TOOLWINDOW; -end; {CreateParams} - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElAppBar/frmOpts.dfm b/sdk/components/ElPack/BCBDemos/ElAppBar/frmOpts.dfm deleted file mode 100644 index eeb503a69f9..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElAppBar/frmOpts.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElAppBar/frmOpts.pas b/sdk/components/ElPack/BCBDemos/ElAppBar/frmOpts.pas deleted file mode 100644 index d7675730895..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElAppBar/frmOpts.pas +++ /dev/null @@ -1,39 +0,0 @@ -unit frmOpts; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ExtCtrls, ElPanel, ElBtnCtl, ElCheckCtl, ElPopBtn; - -type - TOptionsForm = class(TForm) - ElPanel1: TElPanel; - LeftCB: TElCheckBox; - RightCB: TElCheckBox; - TopCB: TElCheckBox; - BottomCB: TElCheckBox; - FloatingCB: TElCheckBox; - btnOK: TElPopupButton; - btnCancel: TElPopupButton; - ElPanel2: TElPanel; - AutoHideCB: TElCheckBox; - KeepSizeCB: TElCheckBox; - TopmostCB: TElCheckBox; - OnScreenCB: TElCheckBox; - TaskBarCB: TElCheckBox; - private - { Private declarations } - public - { Public declarations } - end; - -var - OptionsForm: TOptionsForm; - -implementation - -{$R *.DFM} - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/ABOUT.PAS b/sdk/components/ElPack/BCBDemos/ElKeeper/ABOUT.PAS deleted file mode 100644 index 3962ddc51f8..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/ABOUT.PAS +++ /dev/null @@ -1,63 +0,0 @@ -unit ABOUT; - -interface - -uses Windows, Classes, SysUtils, Graphics, Forms, Controls, StdCtrls, - Buttons, ExtCtrls, ElURLLabel, ElBtnCtl, ElPopBtn, ElFrmPers, ElCLabel, - ElVerInfo, ElXPThemedControl, ElPanel; - -type - TAboutBox = class(TForm) - ElFormPersist1: TElFormPersist; - VerInfo: TElVersionInfo; - Panel1: TElPanel; - ProgramIcon: TImage; - ProductName: TLabel; - Copyright: TLabel; - MailLabel: TElURLLabel; - HomeLabel: TElURLLabel; - Label2: TLabel; - Label3: TLabel; - Label5: TLabel; - lblVersion: TLabel; - NameLabel: TLabel; - Label6: TLabel; - OkBtn: TElPopupButton; - procedure FormCreate(Sender: TObject); - procedure OkBtnClick(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - AboutBox: TAboutBox; - -implementation - -{$R *.DFM} - -procedure TAboutBox.FormCreate(Sender: TObject); -var InfoString : string; -begin - InfoString := ''; - if (InfoString <> '') then - begin - NameLabel.Caption := InfoString; - NameLabel.Visible := true; - NameLabel.Font.Color := clGreen; - end; - lblVersion.Caption := IntToStr(VerInfo.MajorVersion) + '.' + - IntToStr(VerInfo.MinorVersion) + - IntToStr(VerInfo.Release); -end; - -procedure TAboutBox.OkBtnClick(Sender: TObject); -begin - ModalResult := mrCancel; - Close; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/ABOUT.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/ABOUT.dfm deleted file mode 100644 index fe2bbbef5f3..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/ABOUT.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/Clip.res b/sdk/components/ElPack/BCBDemos/ElKeeper/Clip.res deleted file mode 100644 index ee4a682ed9a..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/Clip.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/Cryptcon.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/Cryptcon.pas deleted file mode 100644 index 91d6f75a4f7..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/Cryptcon.pas +++ /dev/null @@ -1,637 +0,0 @@ -unit Cryptcon; -{***************************************************************************** - UNIT: Cryptcon - Description: This unit contains an Object Pascal Object which can be used as - a base class for constructing Encryption Objects for BLOCK - Ciphers. This contains all the necessary fields/methods for - doing encryption. In most cases all that a user of this base class - will need to do is override the EncipherBLOCK/DecipherBLOCK and - SetKeys(generate SubKeys) methods. It handles things such as - File encryption, Byte Array encryption, different modes of - operation(CBC, ECB, CFB). - ----------------------------------------------------------------------------- - Code Author: Greg Carter, gregc@cryptocard.com - Organization: CRYPTOCard Corporation, info@cryptocard.com - R&D Division, Carleton Place, ON, CANADA, K7C 3T2 - 1-613-253-3152 Voice, 1-613-253-4685 Fax. - Date of V.1: Jan. 30 1996. - - Compatibility & Testing with BP7.0: Marcel Roorda, garfield@xs4all.nl - -----------------------------------------------------------------------------} -{Usage: See one of the included algorithm implementations, TRC5, TBLOWFISH, - TIDEA to see how to inherite and use this base class. -{-----------------------------------------------------------------------------} -{LEGAL: This code is placed into the public domain, hence requires - no license or runtime fees. However this code is copyright by - CRYPTOCard. CRYPTOCard grants anyone who may wish to use, modify - or redistribute this code privileges to do so, provided the user - agrees to the following three(3) rules: - - 1)Any Applications, (ie exes which make use of this - Object...), for-profit or non-profit, - must acknowledge the author of this Object(ie. - MD5 Implementation provided by Greg Carter, CRYPTOCard - Corporation) somewhere in the accompanying Application - documentation(ie AboutBox, HelpFile, readme...). NO runtime - or licensing fees are required! - - 2)Any Developer Component(ie Delphi Component, Visual Basic VBX, - DLL) derived from this software must acknowledge that it is - derived from "Crypto Object Pascal Implementation Originated by - Greg Carter, CRYPTOCard Corporation 1996". Also all efforts should - be made to point out any changes from the original. - !!!!!Further, any Developer Components based on this code - *MAY NOT* be sold for profit. This Object was placed into the - public domain, and therefore any derived components should - also.!!!!! - - 3)CRYPTOCard Corporation makes no representations concerning this - software or the suitability of this software for any particular - purpose. It is provided "as is" without express or implied - warranty of any kind. CRYPTOCard accepts no liability from any - loss or damage as a result of using this software. - ------------------------------------------------------------------------------ -Why Use this instead of a freely available C DLL? - -The goal was to provide a number of Encryption/Hash implementations in Object -Pascal, so that the Pascal Developer has considerably more freedom. These -Implementations are geared toward the PC(Intel) Microsoft Windows developer, -who will be using Borland's New 32bit developement environment(Delphi32). The -code generated by this new compiler is considerablely faster then 16bit versions. -And should provide the Developer with faster implementations then those using -C DLLs. ------------------------------------------------------------------------------ -NOTES: ------------------------------------------------------------------------------- -Revised: 00/00/00 BY: ******* Reason: ****** ------------------------------------------------------------------------------- -} - -{Declare the compiler defines} -{$I CRYPTDEF.INC} -{------Changeable compiler switches-----------------------------------} -{$A+ Word align variables } -{$F+ Force Far calls } -{$K+ Use smart callbacks -{$N+ Allow coprocessor instructions } -{$P+ Open parameters enabled } -{$S+ Stack checking } -{$T- @ operator is NOT typed } -{$IFDEF DELPHI} -{$U- Non Pentium safe FDIV } -{$Z- No automatic word-sized enumerations} -{$ENDIF} -{---------------------------------------------------------------------} -{ Modified 17/08/98 12:21:57 by the CDK, Version 3.02 Rev. F } -{ Modified 17/08/98 12:22:42 by the CDK, Version 3.02 Rev. F } - -interface -uses Windows, SysUtils, Classes ; - -type - {An enumerated typt which tells the object what type the input to the cipher is} - TSourceType = (SourceFile, SourceByteArray,SourceString, SourceStream); - {Different modes of cipher operation} - TCipherMode = (ECBMode, CBCMode, CFBMode); - - UWORD_32bits = LongInt; - UWORD_16bits = WORD; - UBYTE_08bits = BYTE; - - BArray = array[0..7] of BYTE; - PArray = ^BArray; - LArray = array[0..1] of UWORD_32bits; - PLong = ^UWORD_32bits; - PLArray = ^LArray; - - singleBytes = Record - byte3: BYTE; {LSB} - byte2: BYTE; - byte1: BYTE; - byte0: BYTE; {MSB} - end;{SingleBytes} -{$DEFINE INTEL} - - aword = record - case Integer Of - 0: (LWord: UWORD_32bits); - 1: (fByte: Array[0..3] of UBYTE_08bits); - 2: (w: singleBytes); - end;{aword, 32bits!} - - Paword = ^aword; -{------------------------------------------------------------------------------} -{TCrypto Object: TCrypto Object descends from the base class(of you respestive - compiler(TComponent for Delphi, TObject for BP7). It is a - basic 'container' to hold all the input/output information to - an encryption routine. - - When using a cipher in CBC or CFB mode the cipher needs an - initialization vector(IV). The user can either supply an - IV vector, by assigning a string value(which MUST be the - same length as block of the cipher) to the FIVector field, or - have an IVector generated for them. If the user chooses to have - the IVector generated(Do not assign it anything), then upon - completion of the current encryption, the FIVector field - will hold the IV vector used. You need to keep a copy of the - IV vector used to encrypt, in order to decrypt anything. It is - not necessary to keep this value secret. - - A destructor fills the Objects copy of the User Key with - zeros on exit for security reasons. - - 'Protected' Fields under Delphi are accessible to desendents of - the inherited object, but not to users of the desendent - objects. --------------------------------------------------------------------------------} - -TCrypto = class(TComponent) - Protected -{ Protected declarations } - FIVector: String; {Initial IVector MUST be as long as FBLOCKSIZE} - FIVTemp: PArray; {IVector during cipher} - FKey: String; {Local Copy of User Key} - FInputType: TSourceType;{SourceString, SourceByteArray, SourceFile} - FCipherMode: TCipherMode;{ECBMode, CBCMode, CFBMode} - FInputFilePath: String; {Path to input file} - FOutputFilePath: String; {Path to output file} - FInputArray: PArray; {Pointer to input array} - FOutputArray: PArray; {Output Array} - FInputStream: TStream; - FOutputStream: TStream; - FInputString: String; {Pascal String to Encipher} - FInputLength: WORD; {16bit Unsigned Length of ByteArray} - FBuffer: array[0..4096] of BYTE; {Local Copy of Data} - FSmallBuffer: array[0..63] of BYTE; - FDoneFile: Boolean; {Signal reading of file or array is done} - FBLOCKSIZE: BYTE; {MUST be initialized in Constructor} - Procedure ShiftLeft(pIV, pNewData: PByte; Pos: WORD); - function MIN(Aparam, Bparam: integer): integer; - Procedure GenIVector; {generates a psedo random IVector} - Procedure InitIV; - Procedure StartCipher(Continue: Boolean); - Procedure EncipherBLOCK; virtual;abstract; - Procedure DecipherBLOCK; virtual;abstract; - {do any SubKey generation or initialization here} - Procedure SetKeys;virtual;abstract; - Procedure Encipher_File; - Procedure Decipher_File; - Procedure Encipher_Bytes;virtual; - Procedure Decipher_Bytes;virtual; -{Different modes for Block Ciphers} - Procedure EncipherECB; - Procedure DecipherECB; - Procedure EncipherCFB; - Procedure DecipherCFB; - Procedure EncipherCBC; - Procedure DecipherCBC; - - procedure Encipher_Stream; - procedure Decipher_Stream; - public -{ Public declarations } - Procedure DecipherData(Continue: Boolean); {Users call these to perform} - Procedure EncipherData(Continue: Boolean); {Encryption/Decryption} - {Continue is used for CBC and CFB Modes, where the encryption procedure - needs to know whether to generate a new Initialization Vector, or use the - one generated in the last round of the previous encryption} - {constructor Create(Owner: TComponent);override;} - destructor Destroy;override; - Property pInputArray: PArray read FInputArray write FInputArray; - Property pOutputArray: PArray read FOutputArray write FOutputArray;{!!See FOutputArray} - published -{Published properties show up in the object inspector} - Property Key: String write FKey Stored False; - Property InputType: TSourceType read FInputType write FInputType; - Property InputFilePath: String read FInputFilePath write FInputFilePath; - Property OutputFilePath: String read FOutputFilePath write FOutputFilePath; - Property InputString: String read FInputString write FInputString; - Property InputLength: WORD read FInputLength write FInputLength; - Property CipherMode: TCipherMode read FCipherMode write FCipherMode; - Property IVector: String read FIVector write FIVector Stored False; - property InputStream: TStream read FInputStream write FInputStream; - property OutputStream: TStream read FOutputStream write FOutputStream; -end;{TCrypto} - -implementation - -destructor TCrypto.Destroy; - var i: integer; - begin - If FIVTemp <> nil then begin - FreeMem(FIVTemp, FBLOCKSIZE); - end; - for i := 1 to Length(FKey) do begin - FKey[i] := #0; - end; - inherited Destroy; -end;{destructor} - -{=======================Misc. Methods=========================================} -function TCrypto.MIN(Aparam, Bparam: integer): integer; -begin - if Aparam > Bparam then - MIN := Bparam - else - MIN := Aparam; -end; - -Procedure TCrypto.ShiftLeft(pIV, pNewData: PByte; Pos: WORD); -{Used in CFB Mode} -var - TempPtr: PByte; - i: BYTE; -begin - TempPtr := pIV; Inc(TempPtr, Pos); - For i:= 1 To (FBLOCKSIZE - Pos) do - pIV^ := TempPtr^; Inc(pIV); //Inc(TempPtr); - repeat - pIV^ := pNewData^; Inc(pIV); Inc(pNewData); - Dec(Pos); - Until Pos = 0; -end;{TCrypto.ShiftLeft} - -Procedure TCrypto.GenIVector; -var - i: WORD; -begin - Randomize; - FIVector := ''; - For i:= 1 to FBLOCKSIZE do begin - FIVector := FIVector + Chr(BYTE(Random(93) + 33)); - {add 33 so all in ascii printable range} - end; -end; - -Procedure TCrypto.InitIV; -begin - {If the user wishes to supply an IV vector then let them, otherwise we - generate one, and put it in FIVector, so that they can see it, also put - IV in FIVTemp, which is used during the cipher routines} - If FIVector = '' then - GenIVector; - if FIVTemp = nil then - GetMem(FIVTemp, FBLOCKSIZE); - Move(FIVector[1], FIVTemp^, FBLOCKSIZE); -end; - -Procedure TCrypto.StartCipher(Continue: Boolean); -begin -if Not Continue then begin - SetKeys; - Case FCipherMode of - ECBMode: - begin - end; - CBCMode: - begin - InitIV; - end; - CFBMode: - begin - InitIV; - end; - end;{Case} -end;{if} -end;{TCrypto.StartCipher} - -{==================Main Entry Public Methods==================================} -Procedure TCrypto.EncipherData(Continue: Boolean); -{Public/Protected Procedure used to encipher data} -var -pStr: PChar; - begin - StartCipher(Continue); - case FInputType of - SourceStream: - Encipher_Stream; - SourceFile: - begin - Encipher_File; - end; - SourceByteArray: - begin - {Check Length!!!!} - Move(FInputArray^, FBuffer, FInputLength); - Encipher_Bytes; - end; - SourceString: - begin - {Convert Pascal String to Byte Array} - pStr := StrAlloc(Length(FInputString) + 1); - try {protect dyanmic memory allocation} - StrPCopy(pStr, FInputString); - FInputLength := Length(FInputString); - FInputArray := Pointer(pStr); - {Check Length!!!!} - Move(FInputArray^, FBuffer, FInputLength); - Encipher_Bytes; - finally - StrDispose(pStr); - end; - end;{SourceString} - end;{case} -end;{TCrypto.EncipherData} - -Procedure TCrypto.DecipherData(Continue: Boolean); -{Public/Proctected Procedure used to Decipher data} - begin - StartCipher(Continue); - case FInputType of - SourceStream: - Decipher_Stream; - SourceFile: - begin - Decipher_File; - end; - SourceByteArray: - begin - {Check Length!!!!} - Move(FInputArray^, FBuffer, FInputLength); - Decipher_Bytes; - end; - SourceString: - begin - {FIXME: Error, can't decipher input as Pascal string} - end;{SourceString} - end;{case} -end;{TCrypto.DecipherData} - -{=========================Data handling Methods===============================} -Procedure TCrypto.Encipher_Bytes; -begin - Case FCipherMode of - ECBMode: - EncipherECB; - CBCMode: - EncipherCBC; - CFBMode: - EncipherCFB; - end;{Case} -end; - -Procedure TCrypto.Encipher_File; -var - InputFile, OutputFile: File; - NumWrite, NumRead: integer; - DoneFile: Boolean; -begin - DoneFile := False; - AssignFile(InputFile, FInputFilePath); - Reset(InputFile, 1); - NumWrite := FileCreate(FOutputFilePath); - FileClose(NumWrite); - AssignFile(OutputFile, FOutputFilePath); - Reset(OutputFile, 1); - repeat - BlockRead(InputFile,FBuffer,4096, NumRead{FInputLength}); - FInputLength := NumRead; - if FInputLength<>4096 then DoneFile := True; - {Call Encipher_Bytes to handle the actual encryption} - FInputArray := @FBuffer; - FOutputArray := @FBuffer; - Encipher_Bytes; - {Case FCipherMode of - ECBMode: - EncipherECB; - CBCMode: - EncipherCBC; - CFBMode: - EncipherCFB; - end;{Case} - {Put in OutputFile} - BlockWrite(OutputFile,FBuffer, FInputLength,NumWrite); - {Should signal a disk full error when numwrite<>FInputLength} - until DoneFile or (NumWrite <> FInputLength); - CloseFile(InputFile); - CloseFile(OutputFile); -{ FInputLength := TotalRead;} -end;{TCrypto.Encipher_File} - -Procedure TCrypto.Decipher_Bytes; -begin - Case FCipherMode of {keep in this order for compiler optimization} - ECBMode: - DecipherECB; - CBCMode: - DecipherCBC; - CFBMode: - DecipherCFB; - end;{Case} -end;{TCrypto.Decipher_Bytes} - -Procedure TCrypto.Decipher_File; -var - InputFile, OutputFile: File; - NumWrite, NumRead: integer ; - DoneFile: Boolean; -begin - DoneFile := False; - AssignFile(InputFile, FInputFilePath); - Reset(InputFile, 1); - NumWrite := FileCreate(FOutputFilePath); - FileClose(NumWrite); - AssignFile(OutputFile, FOutputFilePath); - Reset(OutputFile, 1); - - repeat - BlockRead(InputFile,FBuffer, 4096, NumRead{FInputLength}); - FInputLength := NumRead; - if FInputLength<>4096 then DoneFile := True; - FInputArray := @FBuffer; - FOutputArray := @FBuffer; - Decipher_Bytes; - {Put in OutputFile} - BlockWrite(OutputFile,FBuffer, FInputLength,NumWrite); - {Should signal a disk full error when numwrite<>FInputLength} - until DoneFile or (NumWrite <> FInputLength); - CloseFile(InputFile); - CloseFile(OutputFile); -{ FInputLength := TotalRead;} -end;{TCrypto.Decipher_File} - -{===========================Cipher Mode Methods===============================} -Procedure TCrypto.EncipherCFB; -var - i: WORD; - WhatsLeft, Index: Longint; - pOut: PByte; - curSize : BYTE; -begin - WhatsLeft := FInputLength; - curSize := MIN(FBLOCKSIZE, WhatsLeft); - pOut := PByte(FOutputArray); {get pointer to users outputarray} - Index := 0; - while (curSize > 0) do begin - Move(FIVTemp^, FSmallBuffer, FBLOCKSIZE); - EncipherBLOCK; - For i:= 0 to (curSize - 1) do begin - PArray(pOut)^[i] := FBuffer[Index + i] Xor FSmallBuffer[i]; - end; - If curSize = FBLOCKSIZE then - Move(pOut^, FIVTemp^, FBLOCKSIZE) - else - ShiftLeft(Pointer(FIVTemp), Pointer(pOut), curSize); - Dec(WhatsLeft, curSize); - Inc(pOut, curSize); - Inc(Index, curSize); - curSize:= MIN(FBLOCKSIZE, WhatsLeft); - end;{while} -end;{TCrypto.EncipherCFB} - -Procedure TCrypto.DecipherCFB; -var - i: WORD; - WhatsLeft, Index: Longint; - pOut: PByte; - curSize : BYTE; -begin - WhatsLeft := FInputLength; - curSize := MIN(FBLOCKSIZE, WhatsLeft); - pOut := PByte(FOutputArray); {save pointer to users outputarray} - Index := 0; - while (curSize > 0) do begin - Move(FIVTemp^, FSmallBuffer, FBLOCKSIZE); - EncipherBLOCK; - {Put Cipher Text in Feeback Register, IVTemp} - If curSize = FBLOCKSIZE then - Move(FBuffer[Index], FIVTemp^, FBLOCKSIZE) - else - ShiftLeft(Pointer(FIVTemp), @FBuffer[Index], curSize); - For i:= 0 to (curSize - 1) do begin - PArray(pOut)^[i] := FBuffer[Index + i] Xor FSmallBuffer[i]; - end; - Dec(WhatsLeft, curSize); - Inc(Index, curSize); - Inc(pOut, curSize); - curSize := MIN(FBLOCKSIZE, WhatsLeft); - end;{while} -end;{TCrypto.DecipherCFB} - -Procedure TCrypto.EncipherECB; -var Index: WORD; -begin - {Pad the input to a multiple of 64bits(8BYTES) with Nulls} - while (FInputLength mod FBLOCKSIZE)<>0 do begin - FBuffer[FInputLength] := 0; - Inc(FInputLength); - end; - Index := 0; - repeat {Do one BLOCK at a time} - Move(FBuffer[Index], FSmallBuffer, FBLOCKSIZE); - EncipherBLOCK; - Move(FSmallBuffer, FOutputArray^[Index], FBLOCKSIZE); - Inc(Index,FBLOCKSIZE); - until Index = FInputLength; -end;{TCrypto.EncipherECB} - -Procedure TCrypto.DecipherECB; -var Index: WORD; -begin - {Pad the input to a multiple of FBLOCKSIZE with Nulls} - while (FInputLength mod FBLOCKSIZE)<>0 do begin - FBuffer[FInputLength] := 0; - Inc(FInputLength); - end; - Index := 0; - repeat {Do one BLOCK at a time} - Move(FBuffer[Index], FSmallBuffer, FBLOCKSIZE); - DecipherBLOCK; - Move(FSmallBuffer, FOutputArray^[Index], FBLOCKSIZE); - Inc(Index,FBLOCKSIZE); - until Index = FInputLength; -end;{TCrypto.DecipherECB} - -Procedure TCrypto.EncipherCBC; -{Purpose: Performs Cipher Block Chaining(CBC) mode encrytion. - C_i := E(P_i Xor C_i-1 ) -} -var - pOut: PArray; - Index: LongInt; - i: WORD; -begin - pOut := PArray(FOutputArray); - Index := 0; -{Pad the input to a multiple of FBLOCKSIZE with Nulls} - while (FInputLength mod FBLOCKSIZE)<>0 do begin - FBuffer[FInputLength] := 0; - Inc(FInputLength); - end; - repeat {Do one BLOCK at a time} - Move(FBuffer[Index], FSmallBuffer, FBLOCKSIZE); - For i:= 0 to (FBLOCKSIZE - 1) do begin - FSmallBuffer[i] := FSmallBuffer[i] Xor PArray(FIVTemp)^[i]; - end; - EncipherBLOCK; - Move(FSmallBuffer, FIVTemp^, FBLOCKSIZE); {Put Cipher text in FB register} - Move(FSmallBuffer, pOut^[Index], FBLOCKSIZE);{Put Cipher in Output Buffer} - Inc(Index,FBLOCKSIZE); - until Index = FInputLength; -end;{TCrypto.EncipherCBC} - -Procedure TCrypto.DecipherCBC; -{Purpose: Performs Cipher Block Chaining(CBC) mode Decrytion. - P_i := C_i-1 Xor D(Ci) -} -var - pOut: PArray; - Index : LongInt; - i: WORD; -begin - pOut := PArray(FOutputArray); - Index := 0; -{Pad the input to a multiple of FBLOCKSIZE with Nulls} - while (FInputLength mod FBLOCKSIZE)<>0 do begin - FBuffer[FInputLength] := 0; - Inc(FInputLength); - end; - repeat {Do one BLOCK at a time} - Move(FBuffer[Index], FSmallBuffer, FBLOCKSIZE); - DecipherBLOCK; {Decipher C_i} - For i:= 0 to (FBLOCKSIZE - 1) do begin {xor with C_i-1} - FSmallBuffer[i] := FSmallBuffer[i] Xor PArray(FIVTemp)^[i]; - end; - Move(FBuffer[Index], FIVTemp^, FBLOCKSIZE); {Save next IV} - Move(FSmallBuffer, PArray(pOut)^[Index], FBLOCKSIZE); {Save Plain Text} - Inc(Index,FBLOCKSIZE); - until Index = FInputLength; -end;{TCrypto.EncipherCBC} - -procedure TCrypto.Encipher_Stream; { protected } -var NumWrite: integer; - DoneFile: Boolean; - -begin - DoneFile := false; - repeat - FInputLength := FInputStream.Read(FBuffer, 4096); - if FInputLength<>4096 then DoneFile := True; - FInputArray := @FBuffer; - FOutputArray := @FBuffer; - Encipher_Bytes; - {Put in OutputFile} - NumWrite := FOutputStream.Write(FBuffer, FInputLength); - {Should signal a disk full error when numwrite<>FInputLength} - until DoneFile or (NumWrite <> FInputLength); -end; { Encipher_Stream } - -procedure TCrypto.Decipher_Stream; { protected } -var NumWrite: integer; - DoneFile: Boolean; -begin - DoneFile := false; - repeat - FInputLength := FInputStream.Read(FBuffer, 4096); - if FInputLength<>4096 then DoneFile := True; - FInputArray := @FBuffer; - FOutputArray := @FBuffer; - Decipher_Bytes; - {Put in OutputFile} - NumWrite := FOutputStream.Write(FBuffer, FInputLength); - {Should signal a disk full error when numwrite<>FInputLength} - until DoneFile or (NumWrite <> FInputLength); -end; { Decipher_Stream } - -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/Cryptdef.inc b/sdk/components/ElPack/BCBDemos/ElKeeper/Cryptdef.inc deleted file mode 100644 index b7d9baba1a3..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/Cryptdef.inc +++ /dev/null @@ -1,44 +0,0 @@ -{===CRYPTDEF.INC====================================================== - -Compiler defines for the CRYPTOCard Encryption Component Library. - -CRYPTDEF.INC is Copyright (c) 1996 by CRYPTOCard Corportation - -VERSION HISTORY -10Feb96 1.00 initial release -{=====================================================================} - -{Notes: to deactivate a compiler define, place a period '.' between the - left curly brace and the '$' of '$DEFINE'.} - - -{Undefine this if you don't want debugging info} - -{$DEFINE DEBUG} -{$DEFINE DELPHI} {If you are using DELPHI 32 you MUST Keep DELPHI defined too} -{$DEFINE ORDER_DCBA} {INTEL DO NOT CHANGE UNLESS YOU ARE ON A MAC} -{.$DEFINE ORDER_ABCD} {MAC} -{.$DEFINE BP7} -{.$DEFINE DELPHI32} -{Only define one of the next two} -{$DEFINE i286} {These are for the assembler routines} -{.$DEFINE i386} {Delphi32 allows 386 instructions and no longer - supports inline asm functions} - -{===DO NOT MODIFY ANYTHING BEYOND THIS POINT==========================} - -{------Fixed compiler switches----------------------------------------} -{$B- Short-circuit boolean expressions } -{$G+ 80286+ type instructions } -{$I+ I/O checking via exceptions } -{$V- Disable var string checking } -{$W- No Windows realmode stack frame } -{$X+ Enable extended syntax } -{$Q- NO Integer overflow checking } -{$R- NO Range checking } -{$IFDEF DEBUG} -{$D+,L+,Y+ Enable debug information } -{$ELSE} -{$D-,L-,Y- Disable debug information } -{$ENDIF} -{---------------------------------------------------------------------} diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/DEFINE.INC b/sdk/components/ElPack/BCBDemos/ElKeeper/DEFINE.INC deleted file mode 100644 index b28090f3ef9..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/DEFINE.INC +++ /dev/null @@ -1,2 +0,0 @@ -{$define debug} -{$IMAGEBASE $00400000} diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/ElAES.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/ElAES.pas deleted file mode 100644 index b8374c144c0..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/ElAES.pas +++ /dev/null @@ -1,2478 +0,0 @@ -(**************************************************) -(* *) -(* Advanced Encryption Standard (AES) *) -(* *) -(* Copyright (c) 1998-2001 *) -(* EldoS, Alexander Ionov *) -(* *) -(**************************************************) - -unit ElAES; - -interface - -uses - Classes, SysUtils; - -type - EAESError = class(Exception); - - TAESBuffer = array [0..15] of byte; - TAESKey128 = array [0..15] of byte; - TAESKey192 = array [0..23] of byte; - TAESKey256 = array [0..31] of byte; - TAESExpandedKey128 = array [0..43] of longword; - TAESExpandedKey192 = array [0..53] of longword; - TAESExpandedKey256 = array [0..63] of longword; - -// Key expansion routines for encryption - -procedure ExpandAESKeyForEncryption(const Key: TAESKey128; - var ExpandedKey: TAESExpandedKey128); overload; -procedure ExpandAESKeyForEncryption(const Key: TAESKey192; - var ExpandedKey: TAESExpandedKey192); overload; -procedure ExpandAESKeyForEncryption(const Key: TAESKey256; - var ExpandedKey: TAESExpandedKey256); overload; - -// Block encryption routines - -procedure EncryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey128; - var OutBuf: TAESBuffer); overload; -procedure EncryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey192; - var OutBuf: TAESBuffer); overload; -procedure EncryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey256; - var OutBuf: TAESBuffer); overload; - -// Stream encryption routines (ECB mode) - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey128; Dest: TStream); overload; -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; Dest: TStream); overload; - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey192; Dest: TStream); overload; -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; Dest: TStream); overload; - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey256; Dest: TStream); overload; -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; Dest: TStream); overload; - -// Stream encryption routines (CBC mode) - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey128; const InitVector: TAESBuffer; Dest: TStream); overload; -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; const InitVector: TAESBuffer; - Dest: TStream); overload; - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey192; const InitVector: TAESBuffer; Dest: TStream); overload; -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; const InitVector: TAESBuffer; - Dest: TStream); overload; - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey256; const InitVector: TAESBuffer; Dest: TStream); overload; -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; const InitVector: TAESBuffer; - Dest: TStream); overload; - -// Key transformation routines for decryption - -procedure ExpandAESKeyForDecryption(var ExpandedKey: TAESExpandedKey128); overload; -procedure ExpandAESKeyForDecryption(const Key: TAESKey128; - var ExpandedKey: TAESExpandedKey128); overload; - -procedure ExpandAESKeyForDecryption(var ExpandedKey: TAESExpandedKey192); overload; -procedure ExpandAESKeyForDecryption(const Key: TAESKey192; - var ExpandedKey: TAESExpandedKey192); overload; - -procedure ExpandAESKeyForDecryption(var ExpandedKey: TAESExpandedKey256); overload; -procedure ExpandAESKeyForDecryption(const Key: TAESKey256; - var ExpandedKey: TAESExpandedKey256); overload; - -// Block decryption routines - -procedure DecryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey128; - var OutBuf: TAESBuffer); overload; -procedure DecryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey192; - var OutBuf: TAESBuffer); overload; -procedure DecryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey256; - var OutBuf: TAESBuffer); overload; - -// Stream decryption routines (ECB mode) - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey128; Dest: TStream); overload; -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; Dest: TStream); overload; - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey192; Dest: TStream); overload; -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; Dest: TStream); overload; - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey256; Dest: TStream); overload; -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; Dest: TStream); overload; - -// Stream decryption routines (CBC mode) - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey128; const InitVector: TAESBuffer; Dest: TStream); overload; -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; const InitVector: TAESBuffer; - Dest: TStream); overload; - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey192; const InitVector: TAESBuffer; Dest: TStream); overload; -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; const InitVector: TAESBuffer; - Dest: TStream); overload; - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey256; const InitVector: TAESBuffer; Dest: TStream); overload; -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; const InitVector: TAESBuffer; - Dest: TStream); overload; - -resourcestring - SInvalidInBufSize = 'Invalid buffer size for decryption'; - SReadError = 'Stream read error'; - SWriteError = 'Stream write error'; - -implementation - -type - PLongWord = ^LongWord; - -function Min(A, B: integer): integer; -begin - if A < B then - Result := A - else - Result := B; -end; - -const - Rcon: array [1..30] of longword = ( - $00000001, $00000002, $00000004, $00000008, $00000010, $00000020, - $00000040, $00000080, $0000001B, $00000036, $0000006C, $000000D8, - $000000AB, $0000004D, $0000009A, $0000002F, $0000005E, $000000BC, - $00000063, $000000C6, $00000097, $00000035, $0000006A, $000000D4, - $000000B3, $0000007D, $000000FA, $000000EF, $000000C5, $00000091 - ); - - ForwardTable: array [0..255] of longword = ( - $A56363C6, $847C7CF8, $997777EE, $8D7B7BF6, $0DF2F2FF, $BD6B6BD6, $B16F6FDE, $54C5C591, - $50303060, $03010102, $A96767CE, $7D2B2B56, $19FEFEE7, $62D7D7B5, $E6ABAB4D, $9A7676EC, - $45CACA8F, $9D82821F, $40C9C989, $877D7DFA, $15FAFAEF, $EB5959B2, $C947478E, $0BF0F0FB, - $ECADAD41, $67D4D4B3, $FDA2A25F, $EAAFAF45, $BF9C9C23, $F7A4A453, $967272E4, $5BC0C09B, - $C2B7B775, $1CFDFDE1, $AE93933D, $6A26264C, $5A36366C, $413F3F7E, $02F7F7F5, $4FCCCC83, - $5C343468, $F4A5A551, $34E5E5D1, $08F1F1F9, $937171E2, $73D8D8AB, $53313162, $3F15152A, - $0C040408, $52C7C795, $65232346, $5EC3C39D, $28181830, $A1969637, $0F05050A, $B59A9A2F, - $0907070E, $36121224, $9B80801B, $3DE2E2DF, $26EBEBCD, $6927274E, $CDB2B27F, $9F7575EA, - $1B090912, $9E83831D, $742C2C58, $2E1A1A34, $2D1B1B36, $B26E6EDC, $EE5A5AB4, $FBA0A05B, - $F65252A4, $4D3B3B76, $61D6D6B7, $CEB3B37D, $7B292952, $3EE3E3DD, $712F2F5E, $97848413, - $F55353A6, $68D1D1B9, $00000000, $2CEDEDC1, $60202040, $1FFCFCE3, $C8B1B179, $ED5B5BB6, - $BE6A6AD4, $46CBCB8D, $D9BEBE67, $4B393972, $DE4A4A94, $D44C4C98, $E85858B0, $4ACFCF85, - $6BD0D0BB, $2AEFEFC5, $E5AAAA4F, $16FBFBED, $C5434386, $D74D4D9A, $55333366, $94858511, - $CF45458A, $10F9F9E9, $06020204, $817F7FFE, $F05050A0, $443C3C78, $BA9F9F25, $E3A8A84B, - $F35151A2, $FEA3A35D, $C0404080, $8A8F8F05, $AD92923F, $BC9D9D21, $48383870, $04F5F5F1, - $DFBCBC63, $C1B6B677, $75DADAAF, $63212142, $30101020, $1AFFFFE5, $0EF3F3FD, $6DD2D2BF, - $4CCDCD81, $140C0C18, $35131326, $2FECECC3, $E15F5FBE, $A2979735, $CC444488, $3917172E, - $57C4C493, $F2A7A755, $827E7EFC, $473D3D7A, $AC6464C8, $E75D5DBA, $2B191932, $957373E6, - $A06060C0, $98818119, $D14F4F9E, $7FDCDCA3, $66222244, $7E2A2A54, $AB90903B, $8388880B, - $CA46468C, $29EEEEC7, $D3B8B86B, $3C141428, $79DEDEA7, $E25E5EBC, $1D0B0B16, $76DBDBAD, - $3BE0E0DB, $56323264, $4E3A3A74, $1E0A0A14, $DB494992, $0A06060C, $6C242448, $E45C5CB8, - $5DC2C29F, $6ED3D3BD, $EFACAC43, $A66262C4, $A8919139, $A4959531, $37E4E4D3, $8B7979F2, - $32E7E7D5, $43C8C88B, $5937376E, $B76D6DDA, $8C8D8D01, $64D5D5B1, $D24E4E9C, $E0A9A949, - $B46C6CD8, $FA5656AC, $07F4F4F3, $25EAEACF, $AF6565CA, $8E7A7AF4, $E9AEAE47, $18080810, - $D5BABA6F, $887878F0, $6F25254A, $722E2E5C, $241C1C38, $F1A6A657, $C7B4B473, $51C6C697, - $23E8E8CB, $7CDDDDA1, $9C7474E8, $211F1F3E, $DD4B4B96, $DCBDBD61, $868B8B0D, $858A8A0F, - $907070E0, $423E3E7C, $C4B5B571, $AA6666CC, $D8484890, $05030306, $01F6F6F7, $120E0E1C, - $A36161C2, $5F35356A, $F95757AE, $D0B9B969, $91868617, $58C1C199, $271D1D3A, $B99E9E27, - $38E1E1D9, $13F8F8EB, $B398982B, $33111122, $BB6969D2, $70D9D9A9, $898E8E07, $A7949433, - $B69B9B2D, $221E1E3C, $92878715, $20E9E9C9, $49CECE87, $FF5555AA, $78282850, $7ADFDFA5, - $8F8C8C03, $F8A1A159, $80898909, $170D0D1A, $DABFBF65, $31E6E6D7, $C6424284, $B86868D0, - $C3414182, $B0999929, $772D2D5A, $110F0F1E, $CBB0B07B, $FC5454A8, $D6BBBB6D, $3A16162C - ); - - LastForwardTable: array [0..255] of longword = ( - $00000063, $0000007C, $00000077, $0000007B, $000000F2, $0000006B, $0000006F, $000000C5, - $00000030, $00000001, $00000067, $0000002B, $000000FE, $000000D7, $000000AB, $00000076, - $000000CA, $00000082, $000000C9, $0000007D, $000000FA, $00000059, $00000047, $000000F0, - $000000AD, $000000D4, $000000A2, $000000AF, $0000009C, $000000A4, $00000072, $000000C0, - $000000B7, $000000FD, $00000093, $00000026, $00000036, $0000003F, $000000F7, $000000CC, - $00000034, $000000A5, $000000E5, $000000F1, $00000071, $000000D8, $00000031, $00000015, - $00000004, $000000C7, $00000023, $000000C3, $00000018, $00000096, $00000005, $0000009A, - $00000007, $00000012, $00000080, $000000E2, $000000EB, $00000027, $000000B2, $00000075, - $00000009, $00000083, $0000002C, $0000001A, $0000001B, $0000006E, $0000005A, $000000A0, - $00000052, $0000003B, $000000D6, $000000B3, $00000029, $000000E3, $0000002F, $00000084, - $00000053, $000000D1, $00000000, $000000ED, $00000020, $000000FC, $000000B1, $0000005B, - $0000006A, $000000CB, $000000BE, $00000039, $0000004A, $0000004C, $00000058, $000000CF, - $000000D0, $000000EF, $000000AA, $000000FB, $00000043, $0000004D, $00000033, $00000085, - $00000045, $000000F9, $00000002, $0000007F, $00000050, $0000003C, $0000009F, $000000A8, - $00000051, $000000A3, $00000040, $0000008F, $00000092, $0000009D, $00000038, $000000F5, - $000000BC, $000000B6, $000000DA, $00000021, $00000010, $000000FF, $000000F3, $000000D2, - $000000CD, $0000000C, $00000013, $000000EC, $0000005F, $00000097, $00000044, $00000017, - $000000C4, $000000A7, $0000007E, $0000003D, $00000064, $0000005D, $00000019, $00000073, - $00000060, $00000081, $0000004F, $000000DC, $00000022, $0000002A, $00000090, $00000088, - $00000046, $000000EE, $000000B8, $00000014, $000000DE, $0000005E, $0000000B, $000000DB, - $000000E0, $00000032, $0000003A, $0000000A, $00000049, $00000006, $00000024, $0000005C, - $000000C2, $000000D3, $000000AC, $00000062, $00000091, $00000095, $000000E4, $00000079, - $000000E7, $000000C8, $00000037, $0000006D, $0000008D, $000000D5, $0000004E, $000000A9, - $0000006C, $00000056, $000000F4, $000000EA, $00000065, $0000007A, $000000AE, $00000008, - $000000BA, $00000078, $00000025, $0000002E, $0000001C, $000000A6, $000000B4, $000000C6, - $000000E8, $000000DD, $00000074, $0000001F, $0000004B, $000000BD, $0000008B, $0000008A, - $00000070, $0000003E, $000000B5, $00000066, $00000048, $00000003, $000000F6, $0000000E, - $00000061, $00000035, $00000057, $000000B9, $00000086, $000000C1, $0000001D, $0000009E, - $000000E1, $000000F8, $00000098, $00000011, $00000069, $000000D9, $0000008E, $00000094, - $0000009B, $0000001E, $00000087, $000000E9, $000000CE, $00000055, $00000028, $000000DF, - $0000008C, $000000A1, $00000089, $0000000D, $000000BF, $000000E6, $00000042, $00000068, - $00000041, $00000099, $0000002D, $0000000F, $000000B0, $00000054, $000000BB, $00000016 - ); - - InverseTable: array [0..255] of longword = ( - $50A7F451, $5365417E, $C3A4171A, $965E273A, $CB6BAB3B, $F1459D1F, $AB58FAAC, $9303E34B, - $55FA3020, $F66D76AD, $9176CC88, $254C02F5, $FCD7E54F, $D7CB2AC5, $80443526, $8FA362B5, - $495AB1DE, $671BBA25, $980EEA45, $E1C0FE5D, $02752FC3, $12F04C81, $A397468D, $C6F9D36B, - $E75F8F03, $959C9215, $EB7A6DBF, $DA595295, $2D83BED4, $D3217458, $2969E049, $44C8C98E, - $6A89C275, $78798EF4, $6B3E5899, $DD71B927, $B64FE1BE, $17AD88F0, $66AC20C9, $B43ACE7D, - $184ADF63, $82311AE5, $60335197, $457F5362, $E07764B1, $84AE6BBB, $1CA081FE, $942B08F9, - $58684870, $19FD458F, $876CDE94, $B7F87B52, $23D373AB, $E2024B72, $578F1FE3, $2AAB5566, - $0728EBB2, $03C2B52F, $9A7BC586, $A50837D3, $F2872830, $B2A5BF23, $BA6A0302, $5C8216ED, - $2B1CCF8A, $92B479A7, $F0F207F3, $A1E2694E, $CDF4DA65, $D5BE0506, $1F6234D1, $8AFEA6C4, - $9D532E34, $A055F3A2, $32E18A05, $75EBF6A4, $39EC830B, $AAEF6040, $069F715E, $51106EBD, - $F98A213E, $3D06DD96, $AE053EDD, $46BDE64D, $B58D5491, $055DC471, $6FD40604, $FF155060, - $24FB9819, $97E9BDD6, $CC434089, $779ED967, $BD42E8B0, $888B8907, $385B19E7, $DBEEC879, - $470A7CA1, $E90F427C, $C91E84F8, $00000000, $83868009, $48ED2B32, $AC70111E, $4E725A6C, - $FBFF0EFD, $5638850F, $1ED5AE3D, $27392D36, $64D90F0A, $21A65C68, $D1545B9B, $3A2E3624, - $B1670A0C, $0FE75793, $D296EEB4, $9E919B1B, $4FC5C080, $A220DC61, $694B775A, $161A121C, - $0ABA93E2, $E52AA0C0, $43E0223C, $1D171B12, $0B0D090E, $ADC78BF2, $B9A8B62D, $C8A91E14, - $8519F157, $4C0775AF, $BBDD99EE, $FD607FA3, $9F2601F7, $BCF5725C, $C53B6644, $347EFB5B, - $7629438B, $DCC623CB, $68FCEDB6, $63F1E4B8, $CADC31D7, $10856342, $40229713, $2011C684, - $7D244A85, $F83DBBD2, $1132F9AE, $6DA129C7, $4B2F9E1D, $F330B2DC, $EC52860D, $D0E3C177, - $6C16B32B, $99B970A9, $FA489411, $2264E947, $C48CFCA8, $1A3FF0A0, $D82C7D56, $EF903322, - $C74E4987, $C1D138D9, $FEA2CA8C, $360BD498, $CF81F5A6, $28DE7AA5, $268EB7DA, $A4BFAD3F, - $E49D3A2C, $0D927850, $9BCC5F6A, $62467E54, $C2138DF6, $E8B8D890, $5EF7392E, $F5AFC382, - $BE805D9F, $7C93D069, $A92DD56F, $B31225CF, $3B99ACC8, $A77D1810, $6E639CE8, $7BBB3BDB, - $097826CD, $F418596E, $01B79AEC, $A89A4F83, $656E95E6, $7EE6FFAA, $08CFBC21, $E6E815EF, - $D99BE7BA, $CE366F4A, $D4099FEA, $D67CB029, $AFB2A431, $31233F2A, $3094A5C6, $C066A235, - $37BC4E74, $A6CA82FC, $B0D090E0, $15D8A733, $4A9804F1, $F7DAEC41, $0E50CD7F, $2FF69117, - $8DD64D76, $4DB0EF43, $544DAACC, $DF0496E4, $E3B5D19E, $1B886A4C, $B81F2CC1, $7F516546, - $04EA5E9D, $5D358C01, $737487FA, $2E410BFB, $5A1D67B3, $52D2DB92, $335610E9, $1347D66D, - $8C61D79A, $7A0CA137, $8E14F859, $893C13EB, $EE27A9CE, $35C961B7, $EDE51CE1, $3CB1477A, - $59DFD29C, $3F73F255, $79CE1418, $BF37C773, $EACDF753, $5BAAFD5F, $146F3DDF, $86DB4478, - $81F3AFCA, $3EC468B9, $2C342438, $5F40A3C2, $72C31D16, $0C25E2BC, $8B493C28, $41950DFF, - $7101A839, $DEB30C08, $9CE4B4D8, $90C15664, $6184CB7B, $70B632D5, $745C6C48, $4257B8D0 - ); - - LastInverseTable: array [0..255] of longword = ( - $00000052, $00000009, $0000006A, $000000D5, $00000030, $00000036, $000000A5, $00000038, - $000000BF, $00000040, $000000A3, $0000009E, $00000081, $000000F3, $000000D7, $000000FB, - $0000007C, $000000E3, $00000039, $00000082, $0000009B, $0000002F, $000000FF, $00000087, - $00000034, $0000008E, $00000043, $00000044, $000000C4, $000000DE, $000000E9, $000000CB, - $00000054, $0000007B, $00000094, $00000032, $000000A6, $000000C2, $00000023, $0000003D, - $000000EE, $0000004C, $00000095, $0000000B, $00000042, $000000FA, $000000C3, $0000004E, - $00000008, $0000002E, $000000A1, $00000066, $00000028, $000000D9, $00000024, $000000B2, - $00000076, $0000005B, $000000A2, $00000049, $0000006D, $0000008B, $000000D1, $00000025, - $00000072, $000000F8, $000000F6, $00000064, $00000086, $00000068, $00000098, $00000016, - $000000D4, $000000A4, $0000005C, $000000CC, $0000005D, $00000065, $000000B6, $00000092, - $0000006C, $00000070, $00000048, $00000050, $000000FD, $000000ED, $000000B9, $000000DA, - $0000005E, $00000015, $00000046, $00000057, $000000A7, $0000008D, $0000009D, $00000084, - $00000090, $000000D8, $000000AB, $00000000, $0000008C, $000000BC, $000000D3, $0000000A, - $000000F7, $000000E4, $00000058, $00000005, $000000B8, $000000B3, $00000045, $00000006, - $000000D0, $0000002C, $0000001E, $0000008F, $000000CA, $0000003F, $0000000F, $00000002, - $000000C1, $000000AF, $000000BD, $00000003, $00000001, $00000013, $0000008A, $0000006B, - $0000003A, $00000091, $00000011, $00000041, $0000004F, $00000067, $000000DC, $000000EA, - $00000097, $000000F2, $000000CF, $000000CE, $000000F0, $000000B4, $000000E6, $00000073, - $00000096, $000000AC, $00000074, $00000022, $000000E7, $000000AD, $00000035, $00000085, - $000000E2, $000000F9, $00000037, $000000E8, $0000001C, $00000075, $000000DF, $0000006E, - $00000047, $000000F1, $0000001A, $00000071, $0000001D, $00000029, $000000C5, $00000089, - $0000006F, $000000B7, $00000062, $0000000E, $000000AA, $00000018, $000000BE, $0000001B, - $000000FC, $00000056, $0000003E, $0000004B, $000000C6, $000000D2, $00000079, $00000020, - $0000009A, $000000DB, $000000C0, $000000FE, $00000078, $000000CD, $0000005A, $000000F4, - $0000001F, $000000DD, $000000A8, $00000033, $00000088, $00000007, $000000C7, $00000031, - $000000B1, $00000012, $00000010, $00000059, $00000027, $00000080, $000000EC, $0000005F, - $00000060, $00000051, $0000007F, $000000A9, $00000019, $000000B5, $0000004A, $0000000D, - $0000002D, $000000E5, $0000007A, $0000009F, $00000093, $000000C9, $0000009C, $000000EF, - $000000A0, $000000E0, $0000003B, $0000004D, $000000AE, $0000002A, $000000F5, $000000B0, - $000000C8, $000000EB, $000000BB, $0000003C, $00000083, $00000053, $00000099, $00000061, - $00000017, $0000002B, $00000004, $0000007E, $000000BA, $00000077, $000000D6, $00000026, - $000000E1, $00000069, $00000014, $00000063, $00000055, $00000021, $0000000C, $0000007D - ); - -procedure ExpandAESKeyForEncryption(const Key: TAESKey128; var ExpandedKey: TAESExpandedKey128); -var - I, J: integer; - T: longword; - W0, W1, W2, W3: longword; -begin - ExpandedKey[0] := PLongWord(@Key[0])^; - ExpandedKey[1] := PLongWord(@Key[4])^; - ExpandedKey[2] := PLongWord(@Key[8])^; - ExpandedKey[3] := PLongWord(@Key[12])^; - I := 0; J := 1; - repeat - T := (ExpandedKey[I + 3] shl 24) or (ExpandedKey[I + 3] shr 8); - W0 := LastForwardTable[Byte(T)]; W1 := LastForwardTable[Byte(T shr 8)]; - W2 := LastForwardTable[Byte(T shr 16)]; W3 := LastForwardTable[Byte(T shr 24)]; - ExpandedKey[I + 4] := ExpandedKey[I] xor - (W0 xor ((W1 shl 8) or (W1 shr 24)) xor - ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8))) xor Rcon[J]; - Inc(J); - ExpandedKey[I + 5] := ExpandedKey[I + 1] xor ExpandedKey[I + 4]; - ExpandedKey[I + 6] := ExpandedKey[I + 2] xor ExpandedKey[I + 5]; - ExpandedKey[I + 7] := ExpandedKey[I + 3] xor ExpandedKey[I + 6]; - Inc(I, 4); - until I >= 40; -end; - -procedure ExpandAESKeyForEncryption(const Key: TAESKey192; var ExpandedKey: TAESExpandedKey192); overload; -var - I, J: integer; - T: longword; - W0, W1, W2, W3: longword; -begin - ExpandedKey[0] := PLongWord(@Key[0])^; - ExpandedKey[1] := PLongWord(@Key[4])^; - ExpandedKey[2] := PLongWord(@Key[8])^; - ExpandedKey[3] := PLongWord(@Key[12])^; - ExpandedKey[4] := PLongWord(@Key[16])^; - ExpandedKey[5] := PLongWord(@Key[20])^; - I := 0; J := 1; - repeat - T := (ExpandedKey[I + 5] shl 24) or (ExpandedKey[I + 5] shr 8); - W0 := LastForwardTable[Byte(T)]; W1 := LastForwardTable[Byte(T shr 8)]; - W2 := LastForwardTable[Byte(T shr 16)]; W3 := LastForwardTable[Byte(T shr 24)]; - ExpandedKey[I + 6] := ExpandedKey[I] xor - (W0 xor ((W1 shl 8) or (W1 shr 24)) xor - ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8))) xor Rcon[J]; - Inc(J); - ExpandedKey[I + 7] := ExpandedKey[I + 1] xor ExpandedKey[I + 6]; - ExpandedKey[I + 8] := ExpandedKey[I + 2] xor ExpandedKey[I + 7]; - ExpandedKey[I + 9] := ExpandedKey[I + 3] xor ExpandedKey[I + 8]; - ExpandedKey[I + 10] := ExpandedKey[I + 4] xor ExpandedKey[I + 9]; - ExpandedKey[I + 11] := ExpandedKey[I + 5] xor ExpandedKey[I + 10]; - Inc(I, 6); - until I >= 46; -end; - -procedure ExpandAESKeyForEncryption(const Key: TAESKey256; var ExpandedKey: TAESExpandedKey256); overload; -var - I, J: integer; - T: longword; - W0, W1, W2, W3: longword; -begin - ExpandedKey[0] := PLongWord(@Key[0])^; - ExpandedKey[1] := PLongWord(@Key[4])^; - ExpandedKey[2] := PLongWord(@Key[8])^; - ExpandedKey[3] := PLongWord(@Key[12])^; - ExpandedKey[4] := PLongWord(@Key[16])^; - ExpandedKey[5] := PLongWord(@Key[20])^; - ExpandedKey[6] := PLongWord(@Key[24])^; - ExpandedKey[7] := PLongWord(@Key[28])^; - I := 0; J := 1; - repeat - T := (ExpandedKey[I + 7] shl 24) or (ExpandedKey[I + 7] shr 8); - W0 := LastForwardTable[Byte(T)]; W1 := LastForwardTable[Byte(T shr 8)]; - W2 := LastForwardTable[Byte(T shr 16)]; W3 := LastForwardTable[Byte(T shr 24)]; - ExpandedKey[I + 8] := ExpandedKey[I] xor - (W0 xor ((W1 shl 8) or (W1 shr 24)) xor - ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8))) xor Rcon[J]; - Inc(J); - ExpandedKey[I + 9] := ExpandedKey[I + 1] xor ExpandedKey[I + 8]; - ExpandedKey[I + 10] := ExpandedKey[I + 2] xor ExpandedKey[I + 9]; - ExpandedKey[I + 11] := ExpandedKey[I + 3] xor ExpandedKey[I + 10]; - W0 := LastForwardTable[Byte(ExpandedKey[I + 11])]; - W1 := LastForwardTable[Byte(ExpandedKey[I + 11] shr 8)]; - W2 := LastForwardTable[Byte(ExpandedKey[I + 11] shr 16)]; - W3 := LastForwardTable[Byte(ExpandedKey[I + 11] shr 24)]; - ExpandedKey[I + 12] := ExpandedKey[I + 4] xor - (W0 xor ((W1 shl 8) or (W1 shr 24)) xor - ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8))); - ExpandedKey[I + 13] := ExpandedKey[I + 5] xor ExpandedKey[I + 12]; - ExpandedKey[I + 14] := ExpandedKey[I + 6] xor ExpandedKey[I + 13]; - ExpandedKey[I + 15] := ExpandedKey[I + 7] xor ExpandedKey[I + 14]; - Inc(I, 8); - until I >= 52; -end; - -procedure EncryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey128; - var OutBuf: TAESBuffer); -var - T0, T1: array [0..3] of longword; - W0, W1, W2, W3: longword; -begin - // initializing - T0[0] := PLongWord(@InBuf[0])^ xor Key[0]; - T0[1] := PLongWord(@InBuf[4])^ xor Key[1]; - T0[2] := PLongWord(@InBuf[8])^ xor Key[2]; - T0[3] := PLongWord(@InBuf[12])^ xor Key[3]; - // performing transformation 9 times - // round 1 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[4]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[5]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[6]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[7]; - // round 2 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[8]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[9]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[10]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[11]; - // round 3 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[12]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[13]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[14]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[15]; - // round 4 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[16]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[17]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[18]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[19]; - // round 5 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[20]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[21]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[22]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[23]; - // round 6 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[24]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[25]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[26]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[27]; - // round 7 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[28]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[29]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[30]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[31]; - // round 8 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[32]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[33]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[34]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[35]; - // round 9 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[36]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[37]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[38]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[39]; - // last round of transformations - W0 := LastForwardTable[Byte(T1[0])]; W1 := LastForwardTable[Byte(T1[1] shr 8)]; - W2 := LastForwardTable[Byte(T1[2] shr 16)]; W3 := LastForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[40]; - W0 := LastForwardTable[Byte(T1[1])]; W1 := LastForwardTable[Byte(T1[2] shr 8)]; - W2 := LastForwardTable[Byte(T1[3] shr 16)]; W3 := LastForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[41]; - W0 := LastForwardTable[Byte(T1[2])]; W1 := LastForwardTable[Byte(T1[3] shr 8)]; - W2 := LastForwardTable[Byte(T1[0] shr 16)]; W3 := LastForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[42]; - W0 := LastForwardTable[Byte(T1[3])]; W1 := LastForwardTable[Byte(T1[0] shr 8)]; - W2 := LastForwardTable[Byte(T1[1] shr 16)]; W3 := LastForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[43]; - // finalizing - PLongWord(@OutBuf[0])^ := T0[0]; PLongWord(@OutBuf[4])^ := T0[1]; - PLongWord(@OutBuf[8])^ := T0[2]; PLongWord(@OutBuf[12])^ := T0[3]; -end; - -procedure EncryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey192; - var OutBuf: TAESBuffer); -var - T0, T1: array [0..3] of longword; - W0, W1, W2, W3: longword; -begin - // initializing - T0[0] := PLongWord(@InBuf[0])^ xor Key[0]; - T0[1] := PLongWord(@InBuf[4])^ xor Key[1]; - T0[2] := PLongWord(@InBuf[8])^ xor Key[2]; - T0[3] := PLongWord(@InBuf[12])^ xor Key[3]; - // performing transformation 11 times - // round 1 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[4]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[5]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[6]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[7]; - // round 2 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[8]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[9]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[10]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[11]; - // round 3 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[12]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[13]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[14]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[15]; - // round 4 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[16]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[17]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[18]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[19]; - // round 5 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[20]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[21]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[22]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[23]; - // round 6 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[24]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[25]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[26]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[27]; - // round 7 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[28]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[29]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[30]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[31]; - // round 8 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[32]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[33]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[34]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[35]; - // round 9 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[36]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[37]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[38]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[39]; - // round 10 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[40]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[41]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[42]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[43]; - // round 11 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[44]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[45]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[46]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[47]; - // last round of transformations - W0 := LastForwardTable[Byte(T1[0])]; W1 := LastForwardTable[Byte(T1[1] shr 8)]; - W2 := LastForwardTable[Byte(T1[2] shr 16)]; W3 := LastForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[48]; - W0 := LastForwardTable[Byte(T1[1])]; W1 := LastForwardTable[Byte(T1[2] shr 8)]; - W2 := LastForwardTable[Byte(T1[3] shr 16)]; W3 := LastForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[49]; - W0 := LastForwardTable[Byte(T1[2])]; W1 := LastForwardTable[Byte(T1[3] shr 8)]; - W2 := LastForwardTable[Byte(T1[0] shr 16)]; W3 := LastForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[50]; - W0 := LastForwardTable[Byte(T1[3])]; W1 := LastForwardTable[Byte(T1[0] shr 8)]; - W2 := LastForwardTable[Byte(T1[1] shr 16)]; W3 := LastForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[51]; - // finalizing - PLongWord(@OutBuf[0])^ := T0[0]; PLongWord(@OutBuf[4])^ := T0[1]; - PLongWord(@OutBuf[8])^ := T0[2]; PLongWord(@OutBuf[12])^ := T0[3]; -end; - -procedure EncryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey256; - var OutBuf: TAESBuffer); -var - T0, T1: array [0..3] of longword; - W0, W1, W2, W3: longword; -begin - // initializing - T0[0] := PLongWord(@InBuf[0])^ xor Key[0]; - T0[1] := PLongWord(@InBuf[4])^ xor Key[1]; - T0[2] := PLongWord(@InBuf[8])^ xor Key[2]; - T0[3] := PLongWord(@InBuf[12])^ xor Key[3]; - // performing transformation 13 times - // round 1 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[4]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[5]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[6]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[7]; - // round 2 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[8]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[9]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[10]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[11]; - // round 3 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[12]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[13]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[14]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[15]; - // round 4 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[16]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[17]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[18]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[19]; - // round 5 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[20]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[21]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[22]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[23]; - // round 6 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[24]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[25]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[26]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[27]; - // round 7 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[28]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[29]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[30]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[31]; - // round 8 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[32]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[33]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[34]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[35]; - // round 9 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[36]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[37]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[38]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[39]; - // round 10 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[40]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[41]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[42]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[43]; - // round 11 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[44]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[45]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[46]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[47]; - // round 12 - W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)]; - W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[48]; - W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)]; - W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[49]; - W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)]; - W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[50]; - W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)]; - W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[51]; - // round 13 - W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)]; - W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[52]; - W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)]; - W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[53]; - W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)]; - W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[54]; - W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)]; - W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[55]; - // last round of transformations - W0 := LastForwardTable[Byte(T1[0])]; W1 := LastForwardTable[Byte(T1[1] shr 8)]; - W2 := LastForwardTable[Byte(T1[2] shr 16)]; W3 := LastForwardTable[Byte(T1[3] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[56]; - W0 := LastForwardTable[Byte(T1[1])]; W1 := LastForwardTable[Byte(T1[2] shr 8)]; - W2 := LastForwardTable[Byte(T1[3] shr 16)]; W3 := LastForwardTable[Byte(T1[0] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[57]; - W0 := LastForwardTable[Byte(T1[2])]; W1 := LastForwardTable[Byte(T1[3] shr 8)]; - W2 := LastForwardTable[Byte(T1[0] shr 16)]; W3 := LastForwardTable[Byte(T1[1] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[58]; - W0 := LastForwardTable[Byte(T1[3])]; W1 := LastForwardTable[Byte(T1[0] shr 8)]; - W2 := LastForwardTable[Byte(T1[1] shr 16)]; W3 := LastForwardTable[Byte(T1[2] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[59]; - // finalizing - PLongWord(@OutBuf[0])^ := T0[0]; PLongWord(@OutBuf[4])^ := T0[1]; - PLongWord(@OutBuf[8])^ := T0[2]; PLongWord(@OutBuf[12])^ := T0[3]; -end; - -procedure ExpandAESKeyForDecryption(var ExpandedKey: TAESExpandedKey128); -var - I: integer; - U, F2, F4, F8, F9: longword; -begin - for I := 1 to 9 do - begin - F9 := ExpandedKey[I * 4]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 1]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 1] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 2]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 2] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 3]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 3] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - end; -end; - -procedure ExpandAESKeyForDecryption(const Key: TAESKey128; var ExpandedKey: TAESExpandedKey128); -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - ExpandAESKeyForDecryption(ExpandedKey); -end; - -procedure ExpandAESKeyForDecryption(var ExpandedKey: TAESExpandedKey192); -var - I: integer; - U, F2, F4, F8, F9: longword; -begin - for I := 1 to 11 do - begin - F9 := ExpandedKey[I * 4]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 1]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 1] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 2]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 2] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 3]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 3] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - end; -end; - -procedure ExpandAESKeyForDecryption(const Key: TAESKey192; var ExpandedKey: TAESExpandedKey192); -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - ExpandAESKeyForDecryption(ExpandedKey); -end; - -procedure ExpandAESKeyForDecryption(var ExpandedKey: TAESExpandedKey256); -var - I: integer; - U, F2, F4, F8, F9: longword; -begin - for I := 1 to 13 do - begin - F9 := ExpandedKey[I * 4]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 1]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 1] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 2]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 2] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - F9 := ExpandedKey[I * 4 + 3]; - U := F9 and $80808080; - F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F2 and $80808080; - F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - U := F4 and $80808080; - F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B); - F9 := F9 xor F8; - ExpandedKey[I * 4 + 3] := F2 xor F4 xor F8 xor - (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor - (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24)); - end; -end; - -procedure ExpandAESKeyForDecryption(const Key: TAESKey256; var ExpandedKey: TAESExpandedKey256); -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - ExpandAESKeyForDecryption(ExpandedKey); -end; - -procedure DecryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey128; - var OutBuf: TAESBuffer); -var - T0, T1: array [0..3] of longword; - W0, W1, W2, W3: longword; -begin - // initializing - T0[0] := PLongWord(@InBuf[0])^ xor Key[40]; - T0[1] := PLongWord(@InBuf[4])^ xor Key[41]; - T0[2] := PLongWord(@InBuf[8])^ xor Key[42]; - T0[3] := PLongWord(@InBuf[12])^ xor Key[43]; - // performing transformations 9 times - // round 1 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[36]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[37]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[38]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[39]; - // round 2 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[32]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[33]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[34]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[35]; - // round 3 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[28]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[29]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[30]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[31]; - // round 4 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[24]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[25]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[26]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[27]; - // round 5 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[20]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[21]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[22]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[23]; - // round 6 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[16]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[17]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[18]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[19]; - // round 7 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[12]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[13]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[14]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[15]; - // round 8 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[8]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[9]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[10]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[11]; - // round 9 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[4]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[5]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[6]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[7]; - // last round of transformations - W0 := LastInverseTable[Byte(T1[0])]; W1 := LastInverseTable[Byte(T1[3] shr 8)]; - W2 := LastInverseTable[Byte(T1[2] shr 16)]; W3 := LastInverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[0]; - W0 := LastInverseTable[Byte(T1[1])]; W1 := LastInverseTable[Byte(T1[0] shr 8)]; - W2 := LastInverseTable[Byte(T1[3] shr 16)]; W3 := LastInverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[1]; - W0 := LastInverseTable[Byte(T1[2])]; W1 := LastInverseTable[Byte(T1[1] shr 8)]; - W2 := LastInverseTable[Byte(T1[0] shr 16)]; W3 := LastInverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[2]; - W0 := LastInverseTable[Byte(T1[3])]; W1 := LastInverseTable[Byte(T1[2] shr 8)]; - W2 := LastInverseTable[Byte(T1[1] shr 16)]; W3 := LastInverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[3]; - // finalizing - PLongWord(@OutBuf[0])^ := T0[0]; PLongWord(@OutBuf[4])^ := T0[1]; - PLongWord(@OutBuf[8])^ := T0[2]; PLongWord(@OutBuf[12])^ := T0[3]; -end; - -procedure DecryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey192; - var OutBuf: TAESBuffer); -var - T0, T1: array [0..3] of longword; - W0, W1, W2, W3: longword; -begin - // initializing - T0[0] := PLongWord(@InBuf[0])^ xor Key[48]; - T0[1] := PLongWord(@InBuf[4])^ xor Key[49]; - T0[2] := PLongWord(@InBuf[8])^ xor Key[50]; - T0[3] := PLongWord(@InBuf[12])^ xor Key[51]; - // performing transformations 11 times - // round 1 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[44]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[45]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[46]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[47]; - // round 2 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[40]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[41]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[42]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[43]; - // round 3 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[36]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[37]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[38]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[39]; - // round 4 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[32]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[33]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[34]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[35]; - // round 5 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[28]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[29]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[30]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[31]; - // round 6 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[24]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[25]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[26]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[27]; - // round 7 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[20]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[21]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[22]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[23]; - // round 8 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[16]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[17]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[18]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[19]; - // round 9 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[12]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[13]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[14]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[15]; - // round 10 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[8]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[9]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[10]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[11]; - // round 11 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[4]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[5]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[6]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[7]; - // last round of transformations - W0 := LastInverseTable[Byte(T1[0])]; W1 := LastInverseTable[Byte(T1[3] shr 8)]; - W2 := LastInverseTable[Byte(T1[2] shr 16)]; W3 := LastInverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[0]; - W0 := LastInverseTable[Byte(T1[1])]; W1 := LastInverseTable[Byte(T1[0] shr 8)]; - W2 := LastInverseTable[Byte(T1[3] shr 16)]; W3 := LastInverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[1]; - W0 := LastInverseTable[Byte(T1[2])]; W1 := LastInverseTable[Byte(T1[1] shr 8)]; - W2 := LastInverseTable[Byte(T1[0] shr 16)]; W3 := LastInverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[2]; - W0 := LastInverseTable[Byte(T1[3])]; W1 := LastInverseTable[Byte(T1[2] shr 8)]; - W2 := LastInverseTable[Byte(T1[1] shr 16)]; W3 := LastInverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[3]; - // finalizing - PLongWord(@OutBuf[0])^ := T0[0]; PLongWord(@OutBuf[4])^ := T0[1]; - PLongWord(@OutBuf[8])^ := T0[2]; PLongWord(@OutBuf[12])^ := T0[3]; -end; - -procedure DecryptAES(const InBuf: TAESBuffer; const Key: TAESExpandedKey256; - var OutBuf: TAESBuffer); -var - T0, T1: array [0..3] of longword; - W0, W1, W2, W3: longword; -begin - // initializing - T0[0] := PLongWord(@InBuf[0])^ xor Key[56]; - T0[1] := PLongWord(@InBuf[4])^ xor Key[57]; - T0[2] := PLongWord(@InBuf[8])^ xor Key[58]; - T0[3] := PLongWord(@InBuf[12])^ xor Key[59]; - // performing transformations 13 times - // round 1 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[52]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[53]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[54]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[55]; - // round 2 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[48]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[49]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[50]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[51]; - // round 3 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[44]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[45]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[46]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[47]; - // round 4 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[40]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[41]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[42]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[43]; - // round 5 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[36]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[37]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[38]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[39]; - // round 6 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[32]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[33]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[34]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[35]; - // round 7 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[28]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[29]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[30]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[31]; - // round 8 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[24]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[25]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[26]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[27]; - // round 9 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[20]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[21]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[22]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[23]; - // round 10 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[16]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[17]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[18]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[19]; - // round 11 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[12]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[13]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[14]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[15]; - // round 12 - W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)]; - W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[8]; - W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)]; - W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[9]; - W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)]; - W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[10]; - W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)]; - W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[11]; - // round 13 - W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)]; - W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)]; - T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[4]; - W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)]; - W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)]; - T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[5]; - W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)]; - W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)]; - T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[6]; - W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)]; - W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)]; - T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[7]; - // last round of transformations - W0 := LastInverseTable[Byte(T1[0])]; W1 := LastInverseTable[Byte(T1[3] shr 8)]; - W2 := LastInverseTable[Byte(T1[2] shr 16)]; W3 := LastInverseTable[Byte(T1[1] shr 24)]; - T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[0]; - W0 := LastInverseTable[Byte(T1[1])]; W1 := LastInverseTable[Byte(T1[0] shr 8)]; - W2 := LastInverseTable[Byte(T1[3] shr 16)]; W3 := LastInverseTable[Byte(T1[2] shr 24)]; - T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[1]; - W0 := LastInverseTable[Byte(T1[2])]; W1 := LastInverseTable[Byte(T1[1] shr 8)]; - W2 := LastInverseTable[Byte(T1[0] shr 16)]; W3 := LastInverseTable[Byte(T1[3] shr 24)]; - T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[2]; - W0 := LastInverseTable[Byte(T1[3])]; W1 := LastInverseTable[Byte(T1[2] shr 8)]; - W2 := LastInverseTable[Byte(T1[1] shr 16)]; W3 := LastInverseTable[Byte(T1[0] shr 24)]; - T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16)) - xor ((W3 shl 24) or (W3 shr 8))) xor Key[3]; - // finalizing - PLongWord(@OutBuf[0])^ := T0[0]; PLongWord(@OutBuf[4])^ := T0[1]; - PLongWord(@OutBuf[8])^ := T0[2]; PLongWord(@OutBuf[12])^ := T0[3]; -end; - -// Stream encryption routines (ECB mode) - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey128; Dest: TStream); -var - ExpandedKey: TAESExpandedKey128; -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - EncryptAESStreamECB(Source, Count, ExpandedKey, Dest); -end; - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey192; Dest: TStream); -var - ExpandedKey: TAESExpandedKey192; -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - EncryptAESStreamECB(Source, Count, ExpandedKey, Dest); -end; - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey256; Dest: TStream); -var - ExpandedKey: TAESExpandedKey256; -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - EncryptAESStreamECB(Source, Count, ExpandedKey, Dest); -end; - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Dec(Count, SizeOf(TAESBuffer)); - end; - if Count > 0 then - begin - Done := Source.Read(TempIn, Count); - if Done < Count then - raise EStreamError.Create(SReadError); - FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0); - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - end; -end; - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Dec(Count, SizeOf(TAESBuffer)); - end; - if Count > 0 then - begin - Done := Source.Read(TempIn, Count); - if Done < Count then - raise EStreamError.Create(SReadError); - FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0); - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - end; -end; - -procedure EncryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Dec(Count, SizeOf(TAESBuffer)); - end; - if Count > 0 then - begin - Done := Source.Read(TempIn, Count); - if Done < Count then - raise EStreamError.Create(SReadError); - FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0); - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - end; -end; - -// Stream decryption routines (ECB mode) - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey128; Dest: TStream); -var - ExpandedKey: TAESExpandedKey128; -begin - ExpandAESKeyForDecryption(Key, ExpandedKey); - DecryptAESStreamECB(Source, Count, ExpandedKey, Dest); -end; - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - if (Count mod SizeOf(TAESBuffer)) > 0 then - raise EAESError.Create(SInvalidInBufSize); - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - DecryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Dec(Count, SizeOf(TAESBuffer)); - end; -end; - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey192; Dest: TStream); -var - ExpandedKey: TAESExpandedKey192; -begin - ExpandAESKeyForDecryption(Key, ExpandedKey); - DecryptAESStreamECB(Source, Count, ExpandedKey, Dest); -end; - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - if (Count mod SizeOf(TAESBuffer)) > 0 then - raise EAESError.Create(SInvalidInBufSize); - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - DecryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Dec(Count, SizeOf(TAESBuffer)); - end; -end; - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const Key: TAESKey256; Dest: TStream); -var - ExpandedKey: TAESExpandedKey256; -begin - ExpandAESKeyForDecryption(Key, ExpandedKey); - DecryptAESStreamECB(Source, Count, ExpandedKey, Dest); -end; - -procedure DecryptAESStreamECB(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - if (Count mod SizeOf(TAESBuffer)) > 0 then - raise EAESError.Create(SInvalidInBufSize); - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - DecryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Dec(Count, SizeOf(TAESBuffer)); - end; -end; - -// Stream encryption routines (CBC mode) - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey128; const InitVector: TAESBuffer; Dest: TStream); -var - ExpandedKey: TAESExpandedKey128; -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - EncryptAESStreamCBC(Source, Count, ExpandedKey, InitVector, Dest); -end; - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; const InitVector: TAESBuffer; - Dest: TStream); -var - TempIn, TempOut, Vector: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - Vector := InitVector; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - PLongWord(@TempIn[0])^ := PLongWord(@TempIn[0])^ xor PLongWord(@Vector[0])^; - PLongWord(@TempIn[4])^ := PLongWord(@TempIn[4])^ xor PLongWord(@Vector[4])^; - PLongWord(@TempIn[8])^ := PLongWord(@TempIn[8])^ xor PLongWord(@Vector[8])^; - PLongWord(@TempIn[12])^ := PLongWord(@TempIn[12])^ xor PLongWord(@Vector[12])^; - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Vector := TempOut; - Dec(Count, SizeOf(TAESBuffer)); - end; - if Count > 0 then - begin - Done := Source.Read(TempIn, Count); - if Done < Count then - raise EStreamError.Create(SReadError); - FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0); - PLongWord(@TempIn[0])^ := PLongWord(@TempIn[0])^ xor PLongWord(@Vector[0])^; - PLongWord(@TempIn[4])^ := PLongWord(@TempIn[4])^ xor PLongWord(@Vector[4])^; - PLongWord(@TempIn[8])^ := PLongWord(@TempIn[8])^ xor PLongWord(@Vector[8])^; - PLongWord(@TempIn[12])^ := PLongWord(@TempIn[12])^ xor PLongWord(@Vector[12])^; - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - end; -end; - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey192; const InitVector: TAESBuffer; Dest: TStream); -var - ExpandedKey: TAESExpandedKey192; -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - EncryptAESStreamCBC(Source, Count, ExpandedKey, InitVector, Dest); -end; - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; const InitVector: TAESBuffer; - Dest: TStream); -var - TempIn, TempOut, Vector: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - Vector := InitVector; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - PLongWord(@TempIn[0])^ := PLongWord(@TempIn[0])^ xor PLongWord(@Vector[0])^; - PLongWord(@TempIn[4])^ := PLongWord(@TempIn[4])^ xor PLongWord(@Vector[4])^; - PLongWord(@TempIn[8])^ := PLongWord(@TempIn[8])^ xor PLongWord(@Vector[8])^; - PLongWord(@TempIn[12])^ := PLongWord(@TempIn[12])^ xor PLongWord(@Vector[12])^; - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Vector := TempOut; - Dec(Count, SizeOf(TAESBuffer)); - end; - if Count > 0 then - begin - Done := Source.Read(TempIn, Count); - if Done < Count then - raise EStreamError.Create(SReadError); - FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0); - PLongWord(@TempIn[0])^ := PLongWord(@TempIn[0])^ xor PLongWord(@Vector[0])^; - PLongWord(@TempIn[4])^ := PLongWord(@TempIn[4])^ xor PLongWord(@Vector[4])^; - PLongWord(@TempIn[8])^ := PLongWord(@TempIn[8])^ xor PLongWord(@Vector[8])^; - PLongWord(@TempIn[12])^ := PLongWord(@TempIn[12])^ xor PLongWord(@Vector[12])^; - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - end; -end; - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey256; const InitVector: TAESBuffer; Dest: TStream); -var - ExpandedKey: TAESExpandedKey256; -begin - ExpandAESKeyForEncryption(Key, ExpandedKey); - EncryptAESStreamCBC(Source, Count, ExpandedKey, InitVector, Dest); -end; - -procedure EncryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; const InitVector: TAESBuffer; - Dest: TStream); -var - TempIn, TempOut, Vector: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - Vector := InitVector; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError.Create(SReadError); - PLongWord(@TempIn[0])^ := PLongWord(@TempIn[0])^ xor PLongWord(@Vector[0])^; - PLongWord(@TempIn[4])^ := PLongWord(@TempIn[4])^ xor PLongWord(@Vector[4])^; - PLongWord(@TempIn[8])^ := PLongWord(@TempIn[8])^ xor PLongWord(@Vector[8])^; - PLongWord(@TempIn[12])^ := PLongWord(@TempIn[12])^ xor PLongWord(@Vector[12])^; - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - Vector := TempOut; - Dec(Count, SizeOf(TAESBuffer)); - end; - if Count > 0 then - begin - Done := Source.Read(TempIn, Count); - if Done < Count then - raise EStreamError.Create(SReadError); - FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0); - PLongWord(@TempIn[0])^ := PLongWord(@TempIn[0])^ xor PLongWord(@Vector[0])^; - PLongWord(@TempIn[4])^ := PLongWord(@TempIn[4])^ xor PLongWord(@Vector[4])^; - PLongWord(@TempIn[8])^ := PLongWord(@TempIn[8])^ xor PLongWord(@Vector[8])^; - PLongWord(@TempIn[12])^ := PLongWord(@TempIn[12])^ xor PLongWord(@Vector[12])^; - EncryptAES(TempIn, ExpandedKey, TempOut); - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError.Create(SWriteError); - end; -end; - -// Stream decryption routines (CBC mode) - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey128; const InitVector: TAESBuffer; Dest: TStream); -var - ExpandedKey: TAESExpandedKey128; -begin - ExpandAESKeyForDecryption(Key, ExpandedKey); - DecryptAESStreamCBC(Source, Count, ExpandedKey, InitVector, Dest); -end; - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey128; const InitVector: TAESBuffer; - Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Vector1, Vector2: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - if (Count mod SizeOf(TAESBuffer)) > 0 then - raise EAESError.Create(SInvalidInBufSize); - Vector1 := InitVector; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError(SReadError); - Vector2 := TempIn; - DecryptAES(TempIn, ExpandedKey, TempOut); - PLongWord(@TempOut[0])^ := PLongWord(@TempOut[0])^ xor PLongWord(@Vector1[0])^; - PLongWord(@TempOut[4])^ := PLongWord(@TempOut[4])^ xor PLongWord(@Vector1[4])^; - PLongWord(@TempOut[8])^ := PLongWord(@TempOut[8])^ xor PLongWord(@Vector1[8])^; - PLongWord(@TempOut[12])^ := PLongWord(@TempOut[12])^ xor PLongWord(@Vector1[12])^; - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError(SWriteError); - Vector1 := Vector2; - Dec(Count, SizeOf(TAESBuffer)); - end; -end; - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey192; const InitVector: TAESBuffer; Dest: TStream); -var - ExpandedKey: TAESExpandedKey192; -begin - ExpandAESKeyForDecryption(Key, ExpandedKey); - DecryptAESStreamCBC(Source, Count, ExpandedKey, InitVector, Dest); -end; - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey192; const InitVector: TAESBuffer; - Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Vector1, Vector2: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - if (Count mod SizeOf(TAESBuffer)) > 0 then - raise EAESError.Create(SInvalidInBufSize); - Vector1 := InitVector; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError(SReadError); - Vector2 := TempIn; - DecryptAES(TempIn, ExpandedKey, TempOut); - PLongWord(@TempOut[0])^ := PLongWord(@TempOut[0])^ xor PLongWord(@Vector1[0])^; - PLongWord(@TempOut[4])^ := PLongWord(@TempOut[4])^ xor PLongWord(@Vector1[4])^; - PLongWord(@TempOut[8])^ := PLongWord(@TempOut[8])^ xor PLongWord(@Vector1[8])^; - PLongWord(@TempOut[12])^ := PLongWord(@TempOut[12])^ xor PLongWord(@Vector1[12])^; - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError(SWriteError); - Vector1 := Vector2; - Dec(Count, SizeOf(TAESBuffer)); - end; -end; - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const Key: TAESKey256; const InitVector: TAESBuffer; Dest: TStream); -var - ExpandedKey: TAESExpandedKey256; -begin - ExpandAESKeyForDecryption(Key, ExpandedKey); - DecryptAESStreamCBC(Source, Count, ExpandedKey, InitVector, Dest); -end; - -procedure DecryptAESStreamCBC(Source: TStream; Count: cardinal; - const ExpandedKey: TAESExpandedKey256; const InitVector: TAESBuffer; - Dest: TStream); -var - TempIn, TempOut: TAESBuffer; - Vector1, Vector2: TAESBuffer; - Done: cardinal; -begin - if Count = 0 then - begin - Source.Position := 0; - Count := Source.Size; - end - else Count := Min(Count, Source.Size - Source.Position); - if Count = 0 then exit; - if (Count mod SizeOf(TAESBuffer)) > 0 then - raise EAESError.Create(SInvalidInBufSize); - Vector1 := InitVector; - while Count >= SizeOf(TAESBuffer) do - begin - Done := Source.Read(TempIn, SizeOf(TempIn)); - if Done < SizeOf(TempIn) then - raise EStreamError(SReadError); - Vector2 := TempIn; - DecryptAES(TempIn, ExpandedKey, TempOut); - PLongWord(@TempOut[0])^ := PLongWord(@TempOut[0])^ xor PLongWord(@Vector1[0])^; - PLongWord(@TempOut[4])^ := PLongWord(@TempOut[4])^ xor PLongWord(@Vector1[4])^; - PLongWord(@TempOut[8])^ := PLongWord(@TempOut[8])^ xor PLongWord(@Vector1[8])^; - PLongWord(@TempOut[12])^ := PLongWord(@TempOut[12])^ xor PLongWord(@Vector1[12])^; - Done := Dest.Write(TempOut, SizeOf(TempOut)); - if Done < SizeOf(TempOut) then - raise EStreamError(SWriteError); - Vector1 := Vector2; - Dec(Count, SizeOf(TAESBuffer)); - end; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.bpr b/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.bpr deleted file mode 100644 index 235e865ad78..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.bpr +++ /dev/null @@ -1,125 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -[Version Info] -IncludeVerInfo=1 -AutoIncBuild=0 -MajorVer=2 -MinorVer=8 -Release=2 -Build=68 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1033 -CodePage=1252 - -[Version Info Keys] -CompanyName=EldoS -FileDescription= -FileVersion=2.8.2.68 -InternalName= -LegalCopyright=(c) 1998-2001 EldoS, Eugene Mayevski -LegalTrademarks= -OriginalFilename= -ProductName=EldoS Keeper -ProductVersion=2.81 - -[Excluded Packages] -E:\Temp\ElPack\Code\dceldbB5.bpl=EldoS DB-Aware Controls (Design-time) - -[HistoryLists\hlIncludePath] -Count=1 -Item0=$(BCB)\include;$(BCB)\include\vcl - -[HistoryLists\hlLibraryPath] -Count=4 -Item0=$(BCB)\lib\obj;$(BCB)\lib;..\..\..\exe;e:\projects\elpack\code\source -Item1=$(BCB)\lib\obj;$(BCB)\lib;..\..\..\exe -Item2=$(BCB)\lib\obj;$(BCB)\lib;e:\projects\exe -Item3=$(BCB)\lib\obj;$(BCB)\lib - -[HistoryLists\hlDebugSourcePath] -Count=1 -Item0=$(BCB)\source\vcl - -[HistoryLists\hlConditionals] -Count=1 -Item0=DEBUG - -[Debugging] -DebugSourceDirs= - -[Parameters] -RunParams= -HostApplication= -RemoteHost= -RemotePath= -RemoteDebug=0 - -[Compiler] -ShowInfoMsgs=0 -LinkDebugVcl=1 -LinkCGLIB=0 - -[CORBA] -AddServerUnit=1 -AddClientUnit=1 -PrecompiledHeaders=1 - -[Language] -ActiveLang= -ProjectLang= -RootDir= - - \ No newline at end of file diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.cpp b/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.cpp deleted file mode 100644 index 483c19afe60..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.cpp +++ /dev/null @@ -1,37 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("ElKeeper.res"); -USERES("LOGOSTRS.RES"); -USEFORMNS("ABOUT.PAS", About, AboutBox); -USEUNIT("Cryptcon.pas"); -USEFORMNS("frmPassword.pas", Frmpassword, PasswordDlg); -USEFORMNS("frmPswGen.pas", Frmpswgen, PswGenForm); -USEFORMNS("frmRecProp.pas", Frmrecprop, RecPropsForm); -USEFORMNS("frmQuickAccess.pas", Frmquickaccess, QuickAccessForm); - -USEUNIT("IDEAUnit.pas"); -USEUNIT("KeeperOpts.pas"); -USEFORMNS("LogoMain.pas", Logomain, LogoAppForm); -USEUNIT("LogoStrs.pas"); -USEUNIT("md5unit.pas"); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { -// Application->Initialize(); - Application->Title = "EldoS Keeper"; - Application->HelpFile = "ElKeeper.hlp"; - Application->CreateForm(__classid(TLogoAppForm), &LogoAppForm); - Application->CreateForm(__classid(TPasswordDlg), &PasswordDlg); - Application->CreateForm(__classid(TQuickAccessForm), &QuickAccessForm); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.dpr b/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.dpr deleted file mode 100644 index aef27c3d4e7..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.dpr +++ /dev/null @@ -1,47 +0,0 @@ -{$I DEFINE.INC} - -program ElKeeper; - -uses - Forms, - LogoMain in 'LogoMain.pas' {LogoAppForm}, - ABOUT in 'ABOUT.PAS' {AboutBox}, - frmPassword in 'frmPassword.pas' {PasswordDlg}, - frmRecProp in 'frmRecProp.pas' {RecPropsForm}, - Md5unit in '..\Libs\md5unit.pas', - Ideaunit in '..\Libs\Ideaunit.pas', - frmPswGen in 'frmPswGen.pas' {PswGenForm}, - KeeperOpts in 'KeeperOpts.pas', - frmQuickAccess in 'frmQuickAccess.pas' {QuickAccessForm}, - EntryData in 'EntryData.pas', - frmFolderProp in 'frmFolderProp.pas' {FolderPropsForm}, - FrmOpts in 'FrmOpts.pas' {OptionsForm}; - -{$R *.RES} -{$R LOGOSTRS.RES} - -type - TProcedure = procedure; - -var Form : TForm; - -procedure ExecuteApplication; -begin - Application.Title := 'EldoS Keeper'; - Application.HelpFile := 'ElKeeper.hlp'; - Application.ShowMainForm := false; - Application.CreateForm(TForm, Form); - LogoAppForm := TLogoAppForm.Create(Application); - PasswordDlg := TPasswordDlg.Create(Application); - QuickAccessForm := TQuickAccessForm.Create(Application); - LogoAppForm.Show; - with Application do - repeat - HandleMessage - until Terminated; -end; - -begin - ExecuteApplication; -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.res b/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.res deleted file mode 100644 index 282c2f818f2..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/ElKeeper.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/EntryData.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/EntryData.pas deleted file mode 100644 index 884e8ad2757..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/EntryData.pas +++ /dev/null @@ -1,380 +0,0 @@ -unit EntryData; - -interface - -uses ElAES, ElMTree, ElStack, Windows, Classes, SysUtils, ElTools; - -type PEntryRec = ^TEntryRec; - TEntryRec = record - ParentID, - RecID : DWORD; - Group : boolean; - Expanded : boolean; - Site, - Location, - Location2, - UName, - Acct, - Pswd, - Info : string; - Added, - Modified, - Expires : TDateTime; - DoExpires : boolean; - WarnDays : integer; - ExpWarned : boolean; - BinDataSize: integer; - BinData : Pointer; - end; - -var - FMTree : TElMTree; - LoadStack : TElStack; - FileVersion: integer; - AssignedID : integer; - -const FILE_VERSION = 5; - -function UniqueID: Integer; -function GetItemByID(ID : integer): PEntryRec; - -procedure DoItemLoad(Item : TElMTreeItem; Stream : TStream); -procedure DoItemSave(Item : TElMTreeItem; Stream : TStream); - -function AESEncrypt(Data : PChar; DataLen : integer; Key : Pointer): string; -function AESDecrypt(Data : PChar; DataLen : integer; Key : pointer) : string; - -implementation - -function GetItemByID(ID : integer): PEntryRec; -type TSearchRec = record - Id : DWORD; - Result : PEntryRec; - end; - PSearchRec = ^TSearchRec; - -var SearchRec : TSearchRec; - - procedure IntProc(Item : TElMTreeItem; Index : integer; var ContinueIterate : boolean; - IterateData : pointer); - var Entry : PEntryRec; - begin - if Item <> nil then - begin - Entry := PEntryRec(Item.Data); - if Entry.RecID = PSearchRec(IterateData).ID then - begin - PSearchRec(IterateData).Result := Entry; - ContinueIterate := false; - exit; - end; - end; - end; - -begin - SearchRec.Result := nil; - FMTree.Iterate(@IntProc, @SearchRec); - result := SearchRec.Result; -end; - -function UniqueID: Integer; -begin - repeat - Result := AssignedID; - Inc(AssignedID); - until GetItemByID(Result) = nil; -end; - -procedure DoItemLoad(Item : TElMTreeItem; Stream : TStream); -var - Entry : PEntryRec; - i : integer; - p : PChar; - b, version : byte; - -begin - try - New(Entry); - FillMemory(Entry, sizeof(Entry^), 0); - Item^.Data := Entry; - Stream.ReadBuffer(b, sizeof(byte)); - if b < 2 then - begin - version := 1; - Entry^.Group := boolean(b); - end else - begin - version := b; - Stream.ReadBuffer(b, sizeof(byte)); - Entry^.Group := boolean(b); - end; - - Stream.ReadBuffer(i, sizeof (integer)); - if (i < 0) or (i > 65535) then - raise EOutOfMemory.Create(''); - GetMem(P, i+1); - P[i]:=#0; - Stream.ReadBuffer(p^, i); - Entry^.Site := StrPas(p); - FreeMem(p); - - if (Version < 5) and Entry.Group then - begin - exit; - end; - - Stream.ReadBuffer(i, sizeof (integer)); - GetMem(P, i+1); - P[i]:=#0; - Stream.ReadBuffer(p^, i); - Entry^.Location := StrPas(p); - FreeMem(p); - - if version > 1 then - begin - Stream.ReadBuffer(i, sizeof (integer)); - if (i < 0) or (i > 65535) then - raise EOutOfMemory.Create(''); - GetMem(P, i+1); - P[i]:=#0; - Stream.ReadBuffer(p^, i); - Entry^.Location2 := StrPas(p); - FreeMem(p); - end; - - Stream.ReadBuffer(i, sizeof (integer)); - if (i < 0) or (i > 65535) then - raise EOutOfMemory.Create(''); - - GetMem(P, i+1); - P[i]:=#0; - Stream.ReadBuffer(p^, i); - Entry^.UName := StrPas(p); - FreeMem(p); - - Stream.ReadBuffer(i, sizeof (integer)); - if (i < 0) or (i > 65535) then - raise EOutOfMemory.Create(''); - GetMem(P, i+1); - P[i]:=#0; - Stream.ReadBuffer(p^, i); - Entry^.Acct := StrPas(p); - FreeMem(p); - - Stream.ReadBuffer(i, sizeof (integer)); - if (i < 0) or (i > 65535) then - raise EOutOfMemory.Create(''); - - GetMem(P, i+1); - P[i]:=#0; - Stream.ReadBuffer(p^, i); - Entry^.Pswd := StrPas(p); - FreeMem(p); - - Stream.ReadBuffer(i, sizeof (integer)); - if (i < 0) or (i > 65535) then - raise EOutOfMemory.Create(''); - - GetMem(P, i+1); - P[i]:=#0; - Stream.ReadBuffer(p^, i); - Entry^.Info := StrPas(p); - FreeMem(p); - - if Version <= 3 then - Entry.RecID := UniqueID; - - if version > 2 then - begin - Stream.ReadBuffer(Entry.Added, sizeof(Entry.Added)); - Stream.ReadBuffer(Entry.Modified, sizeof(Entry.Modified)); - Stream.ReadBuffer(Entry.Expires, sizeof(Entry.Expires)); - Stream.ReadBuffer(Entry.DoExpires, sizeof(Entry.DoExpires)); - Stream.ReadBuffer(Entry.WarnDays, sizeof(Entry.WarnDays)); - Stream.ReadBuffer(Entry.ExpWarned, sizeof(Entry.ExpWarned)); - if Version > 3 then - begin - Stream.ReadBuffer(Entry.Expanded, sizeof(Entry.Expanded)); - - // Read IDs - Stream.ReadBuffer(Entry.ParentID, sizeof(Entry.ParentID)); - Stream.ReadBuffer(Entry.RecID, sizeof(Entry.RecID)); - - // Read binary data - Stream.ReadBuffer(Entry.BinDataSize, sizeof(Entry.BinDataSize)); - if Entry.BinDataSize > 0 then - begin - GetMem(Entry.BinData, Entry.BinDataSize); - Stream.ReadBuffer(PChar(Entry.BinData)^, Entry.BinDataSize); - end; - end; - end else - begin - Entry^.Added := Now; - Entry^.Modified := Now; - end; - except - on E : Exception do - begin - Item.Data := nil; - raise; - end; - end; -end; { OnItemLoad } - -procedure DoItemSave(Item : TElMTreeItem; Stream : TStream); -var Entry : PEntryRec; - P : PChar; - i : integer; - b : byte; -begin - Entry := PEntryRec(Item^.Data); - b := FILE_VERSION; - Stream.WriteBuffer(b, Sizeof(boolean)); - Stream.WriteBuffer(Entry^.Group, Sizeof(boolean)); - i := Length(Entry^.Site); - Stream.WriteBuffer(i, sizeof(integer)); - P := PChar(Entry^.Site); - Stream.WriteBuffer(P^, i); - - i := Length(Entry^.Location); - Stream.WriteBuffer(i, sizeof(integer)); - P := PChar(Entry^.Location); - Stream.WriteBuffer(P^, i); - i := Length(Entry^.Location2); - Stream.WriteBuffer(i, sizeof(integer)); - P := PChar(Entry^.Location2); - Stream.WriteBuffer(P^, i); - i := Length(Entry^.UName); - Stream.WriteBuffer(i, sizeof(integer)); - P := PChar(Entry^.UName); - Stream.WriteBuffer(P^, i); - i := Length(Entry^.Acct); - Stream.WriteBuffer(i, sizeof(integer)); - P := PChar(Entry^.Acct); - Stream.WriteBuffer(P^, i); - i := Length(Entry^.Pswd); - Stream.WriteBuffer(i, sizeof(integer)); - P := PChar(Entry^.Pswd); - Stream.WriteBuffer(P^, i); - i := Length(Entry^.Info); - Stream.WriteBuffer(i, sizeof(integer)); - P := PChar(Entry^.Info); - Stream.WriteBuffer(P^, i); - // version 3 - Stream.WriteBuffer(Entry.Added, sizeof(Entry.Added)); - Stream.WriteBuffer(Entry.Modified, sizeof(Entry.Modified)); - Stream.WriteBuffer(Entry.Expires, sizeof(Entry.Expires)); - Stream.WriteBuffer(Entry.DoExpires, sizeof(Entry.DoExpires)); - Stream.WriteBuffer(Entry.WarnDays, sizeof(Entry.WarnDays)); - Stream.WriteBuffer(Entry.ExpWarned, sizeof(Entry.ExpWarned)); - // version 4 - - Stream.WriteBuffer(Entry.Expanded, sizeof(Entry.Expanded)); - - // Write IDs - Stream.WriteBuffer(Entry.ParentID, sizeof(Entry.ParentID)); - Stream.WriteBuffer(Entry.RecID, sizeof(Entry.RecID)); - - // Read binary data - Stream.WriteBuffer(Entry.BinDataSize, sizeof(Entry.BinDataSize)); - if Entry.BinDataSize > 0 then - begin - Stream.WriteBuffer(PChar(Entry.BinData)^, Entry.BinDataSize); - end; -end; { OnItemSave } - -function AESDecrypt(Data : PChar; DataLen : integer; Key : pointer) : string; -var l, rl : integer; - InStream : TElMemoryStream; - OutStream : TStringStream; - -type - PAESKey128 = ^TAESKey128; - - procedure DecryptStream(Source: TStream; Dest: TStream; Key: TAESKey128); - var - Count: integer; - DPos: integer; - begin - Source.Position := 0; - DPos := Dest.Position; - Source.ReadBuffer(Count, SizeOf(Count)); // read original size of data - // stream - DecryptAESStreamECB(Source, Source.Size - Source.Position, Key, Dest); - Dest.Size := DPos + Count; // restore the original size of data - Dest.Position := DPos; - end; - -begin - result := ''; - l := DataLen; - - MoveMemory(@rl, PChar(Data), sizeof(integer)); - if (l - sizeof(integer) >= rl) then - begin - InStream := TElMemoryStream.Create; - try - try - InStream.SetPointer(Data, l); - OutStream := TStringStream.Create(''); - try - DecryptStream(InStream, OutStream, PAESKey128(Key)^); - result := OutStream.DataString; - finally - OutStream.Free; - end; - finally - InStream.SetPointer(nil, 0); - end; - finally - InStream.Free; - end; - end; -end; - -function AESEncrypt(Data : PChar; DataLen : integer; Key : Pointer): string; -var InStream : TElMemoryStream; - OutStream : TStringStream; - -type - PAESKey128 = ^TAESKey128; - - procedure EncryptStream(Source: TStream; Dest: TStream; Key: TAESKey128); - var - Count: integer; - begin - Source.Position := 0; - Count := Source.Size; - Dest.Write(Count, SizeOf(Count)); // store the source stream size to - // restore after decryption - EncryptAESStreamECB(Source, 0, Key, Dest); - end; - -begin - if Key = nil then - result := #0#0#0#0 - else - begin - InStream := TElMemoryStream.Create; - try - try - InStream.SetPointer(Data, DataLen); - OutStream := TStringStream.Create(''); - try - EncryptStream(InStream, OutStream, PAESKey128(Key)^); - result := OutStream.DataString; - finally - OutStream.Free; - end; - finally - InStream.SetPointer(nil, 0); - end; - finally - InStream.Free; - end; - end; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/FrmOpts.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/FrmOpts.dfm deleted file mode 100644 index 75bc60e1f0c..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/FrmOpts.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/FrmOpts.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/FrmOpts.pas deleted file mode 100644 index 4d3653eb417..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/FrmOpts.pas +++ /dev/null @@ -1,100 +0,0 @@ -unit FrmOpts; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - KeeperOpts, ElBtnCtl, ElPopBtn, ElCheckCtl, StdCtrls, ExtCtrls, ElPanel, - ElGroupBox, ElXPThemedControl; - -type - TOptionsForm = class(TForm) - FontDlg: TFontDialog; - ElPanel1: TElPanel; - ElGroupBox1: TElGroupBox; - MinToTrayCB: TElCheckBox; - MinOnCloseCB: TElCheckBox; - MinOnEscCB: TElCheckBox; - ElGroupBox3: TElGroupBox; - CountExpandCB: TElCheckBox; - ElGroupBox2: TElGroupBox; - RememberMRUCB: TElCheckBox; - RememberPswCB: TElCheckBox; - ReopenLastFileCB: TElCheckBox; - FontBtn: TElPopupButton; - CancelBtn: TElPopupButton; - OKBtn: TElPopupButton; - procedure FontBtnClick(Sender: TObject); - private - { Private declarations } - public - procedure SetData; - procedure GetData; - end; - -var - OptionsForm: TOptionsForm; - -implementation - -uses frmQuickAccess, LogoMain, Registry; - -{$R *.DFM} - -procedure TOptionsForm.SetData; -begin - MinToTrayCB.Checked := Options.ToTray; - ReopenLastFileCB.Checked := Options.ReopenFile; - RememberMRUCB.Checked := not Options.SaveKeys; - RememberPswCB.Checked := Options.KeepPassword; - MinOnEscCB.Checked := Options.MinimizeOnEsc; - MinOnCloseCB.Checked := Options.MinimizeOnClose; - CountExpandCB.Checked := Options.CountFolderChanges; -end; - -procedure TOptionsForm.GetData; -begin - Options.ToTray := MinToTrayCB.Checked; - Options.ReopenFile := ReopenLastFileCB.Checked; - Options.SaveKeys := not RememberMRUCB.Checked; - Options.KeepPassword := RememberPswCB.Checked; - Options.MinimizeOnEsc := MinOnEscCB.Checked; - Options.MinimizeOnClose := MinOnCloseCB.Checked; - Options.CountFolderChanges := CountExpandCB.Checked; -end; - -procedure TOptionsForm.FontBtnClick(Sender: TObject); -var Reg : TRegistry; - St : TFontStyles; - -begin - FontDlg.Font.Assign(LogoAppForm.Tree.Font); - if FontDlg.Execute then - with LogoAppForm do - begin - Tree.Font.Assign(FontDlg.Font); - Tree.TextColor := FontDlg.Font.Color; - - QuickAccessForm.Tree.Font.Assign(FontDlg.Font); - QuickAccessForm.Tree.TextColor := FontDlg.Font.Color; - - Reg:=nil; - try - try - Reg:=TRegistry.Create; - Reg.OpenKey('Software\EldoS\Keeper', true); - Reg.WriteString('FontName', Tree.Font.Name); - Reg.WriteInteger('FontCharset', Integer(Tree.Font.Charset)); - Reg.WriteInteger('FontSize', Tree.Font.Size); - St := Tree.Font.Style; - Reg.WriteBinaryData('FontStyles', St, sizeof(TFontStyles)); - finally - Reg.Free; - end; - except - on E: Exception do ; - end; - end; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/IDEAUnit.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/IDEAUnit.pas deleted file mode 100644 index d54152910af..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/IDEAUnit.pas +++ /dev/null @@ -1,418 +0,0 @@ -unit Ideaunit; -{***************************************************************************** - UNIT: Ideaunit - Description: This unit contains an Object Pascal Object which can be used to - perform IDEA encryption/decryption. IDEA is a block cipher - developed by Xuejia Lai and James L. Massey of ETH Zurich. - The algorithm is considered to be more secure then DES. It - uses a 128-bit key. For a complete description of the algorithm - see 'Applied Cryptography' by Bruce Shneier, ISBN - 0-471-11709-9. - - The IDEA Algorithm patent protected by Ascom-Tech AG.(See LEGAL) - ----------------------------------------------------------------------------- - Code Author: Greg Carter, gregc@cryptocard.com - Organization: CRYPTOCard Corporation, info@cryptocard.com - R&D Division, Carleton Place, ON, CANADA, K7C 3T2 - 1-613-253-3152 Voice, 1-613-253-4685 Fax. - Date of V.1: Jan. 3 1996. - - Compatibility & Testing with BP7.0: Anne Marcel Roorda, garfield@xs4all.nl - -----------------------------------------------------------------------------} - {Useage: Below is typical usage(for File)of the IDEA Object, - Follow these steps: - 1) Declare and Create Variable of type TIDEA. - 2) Set InputSource Type, either SourceFile, SourceByteArray, or - SourceString(Pascal style string). - 3) Set Cipher Mode, optionally IVector. - 4) Point to Input Source and set Input Length(If needed) - 5) Point to Output Structure(array, file). - 6) Set Key; - 7) Call BF_EncipherData Method. - 8) Reference the Output. Thats it. - **** Note **** Steps 2..6 can occure in any order. - Here is a procedure in Delphi used to encrypt a file: -procedure Tcryptfrm.OpenCiphButtonClick(Sender: TObject); -var - IDEA: TIDEA; (*Step 1*) -begin -IDEA := TIDEA.Create;(*Step 1b*) - try - If OpenDialog1.Execute then - begin - IDEA.InputType := SourceFile; (*Step 2*) - IDEA.CipherMode := ECBMode; (*Step 3*) - IDEA.InputFilePath := OpenDialog1.FileName; (*Step 4*) - IDEA.OutputFilePath := ChangeFileExt(OpenDialog1.FileName, '.ccc'); (*Step 5*) - IDEA.Key := 'abcdefghijklmnopqrstuvwxyz'; (*Step 6*) - IDEA.BF_EncipherData(False); (*Step 7*) - end; - finally - IDEA.free; - end; -end; -{-----------------------------------------------------------------------------} -{LEGAL: The algorithm is patent protected by Ascom-Tech AG. No license - fees are required for non-commerical use. Commerical users should - contact Ascom Systec AG, Dept CMVV, Gewerbepark, CH-5506, - Magenwil, Switzerland, voice 41 64 56 59 83, fax 41 64 56 59 90, - email idea@ascom.ch - - This code is copyright by CRYPTOCard. CRYPTOCard grants anyone - who may wish to use, modify or redistribute this code privileges - to do so, provided the user agrees to the following three(3) - rules: - - 1)Any Applications, (ie exes which make use of this - Object...), for-profit or non-profit, - must acknowledge the author of this Object(ie. - IDEA Implementation provided by Greg Carter, CRYPTOCard - Corporation) somewhere in the accompanying Application - documentation(ie AboutBox, HelpFile, readme...). NO runtime - or licensing fees are required! - - 2)Any Developer Component(ie Delphi Component, Visual Basic VBX, - DLL) derived from this software must acknowledge that it is - derived from "IDEA Object Pascal Implementation Originated by - Greg Carter, CRYPTOCard Corporation 1996". Also all efforts should - be made to point out any changes from the original. - !!!!!Further, any Developer Components based on this code - *MAY NOT* be sold for profit. This Object was placed into the - public domain, and therefore any derived components should - also.!!!!! - - 3)CRYPTOCard Corporation makes no representations concerning this - software or the suitability of this software for any particular - purpose. It is provided "as is" without express or implied - warranty of any kind. CRYPTOCard accepts no liability from any - loss or damage as a result of using this software. - -CRYPTOCard Corporation is in no way affiliated with Ascom-Tech AG. ------------------------------------------------------------------------------ -Why Use this instead of a freely available C DLL? - -The goal was to provide a number of Encryption/Hash implementations in Object -Pascal, so that the Pascal Developer has considerably more freedom. These -Implementations are geared toward the PC(Intel) Microsoft Windows developer, -who will be using Borland's New 32bit developement environment(Delphi32). The -code generated by this new compiler is considerablely faster then 16bit versions. -And should provide the Developer with faster implementations then those using -C DLLs. ------------------------------------------------------------------------------ -NOTES: Make sure to read the LEGAL notes!!!! ------------------------------------------------------------------------------- -Revised: 00/00/00 BY: ******* Reason: ****** ------------------------------------------------------------------------------- -} -interface -{Declare the compiler defines} -{$I CRYPTDEF.INC} -{------Changeable compiler switches-----------------------------------} -{$A+ Word align variables } -{$F+ Force Far calls } -{$K+ Use smart callbacks -{$N+ Allow coprocessor instructions } -{$P+ Open parameters enabled } -{$S+ Stack checking } -{$T- @ operator is NOT typed } -{$IFDEF DELPHI} -{$U- Non Pentium safe FDIV } -{$Z- No automatic word-sized enumerations} -{$ENDIF} -{---------------------------------------------------------------------} -{$DEFINE ORDER_BA} -uses SysUtils, Cryptcon, Classes, Controls; - -const - IDEAKEYSIZE = 16; - IDEABLOCKSIZE = 8; - ROUNDS = 8; - KEYLEN = (6*ROUNDS + 4); -type - -UWORD16 = WORD; {16 unsigned integer} -pUWORD16 = ^UWORD16; -UWORD32 = LongInt; {Turn off Overflow checking} - -{Intelx86} - singleByte = Record - byte1: BYTE;{LSB} - byte0: BYTE;{MSB} - end;{SingleBytes} -{$DEFINE INTEL} - - aword16 = record - case Integer Of - 0: (SWord: UWORD16); - 1: (fByte: Array[0..1] of BYTE); - 2: (w: singleByte); - end;{aword, 16bits!} - -Paword = ^aword16; - -IDEA_BLOCK = record - X1: UWORD16; - X2: UWORD16; - X3: UWORD16; - X4: UWORD16; -end; - -pIDEA_BLOCK = ^IDEA_BLOCK; -KeyArray = array[0..(KEYLEN - 1)] of aword16; -PKeyArray = ^KeyArray; - - TIDEA = class(TCrypto) - Private - { Private declarations } - FpKey: PChar; - FRounds: BYTE; -{ FActiveBlock: IDEA_BLOCK;} - FpActiveBlock: pIDEA_BLOCK; - FEnCiKey: KeyArray; {Encipher Key} - FDeCiKey: KeyArray; {Decipher Key} - FCiKey: pUWORD16; {Pointer to current Key, either Encipher or Decipher Key} - Function MUL(pX, pY: pUWORD16): UWORD16; - Function INV(pX: pUWORD16): UWORD16; - Procedure IDEA_ExpandKey; - Procedure IDEA_InvertKey; - Procedure IDEA_Cipher; {En/Deciphers 64bit block depending on Key} - Procedure EncipherBLOCK;override; {Enciphers BLOCK} - Procedure DecipherBLOCK;override; {Deciphers BLOCK} - Procedure SetKeys; override; {Sets up En\DecipherKey SubKeys} - protected - { Protected declarations } - public - { Public declarations } - constructor Create(Owner: TComponent);override; - destructor Destroy;override; - end;{TIDEA} - - procedure Register;{register the component to the Delphi toolbar} - -implementation - -procedure Register; - {Registers the Component to the toobar, on the tab named 'Crypto'} - {Now all a Delphi programmer needs to do is drag n drop to have - Blowfish encryption} -begin - RegisterComponents('Crypto', [TIDEA]); -end; - -constructor TIDEA.Create(Owner: TComponent); -begin - FRounds := 8; - FBLOCKSIZE := SizeOf(IDEA_BLOCK); - FIVTemp := nil; - FpKey := StrAlloc(IDEAKEYSIZE + 1); - inherited Create(Owner); - FpActiveBlock := @FSmallBuffer; -end;{Create} - -destructor TIDEA.Destroy; -begin - StrDispose(FpKey); - inherited Destroy; -end;{TBlowFish.Destroy;} - -Function TIDEA.MUL(pX, pY: pUWORD16): UWORD16; -var - p: UWORD32; - x, y: UWORD16; -begin - p := UWORD32(pX^) * pY^; - if p = 0 then - x := 65537 - pX^ - pY^ - else begin - x := UWORD16(p SHR 16); - y := UWORD16(p); - x := y - x; - - if (y < x) then Inc(x, 65537); - end; - - MUL := x; -end;{TIDEA.MUL} - -Function TIDEA.INV(pX: pUWORD16): UWORD16; -var - t0, t1, q, y, x: UWORD16; -begin - x := PX^; - if (x <= 1) then begin - INV := x; - exit; - end; - t1 := UWORD16(65537 Div x); - y := UWORD16(65537 MOD x); - t0 := 1; - while y <> 1 do begin - q := x Div y; - x := x MOD y; - t0 := t0 + (t1 * q); - if x = 1 then begin - INV := t0; - exit; - end; - q := y Div x; - y := y MOD x; - t1 := t1 + (t0 * q); - end;{while} - - INV := 1 - t1; -end;{TIDEA.INV} - - -Procedure TIDEA.IDEA_ExpandKey; -var - i, j : BYTE; - pKey: PKeyArray; -begin - pKey := @FEnCiKey; - j:= 0; - for i:= 0 to 7 do begin - FEnCiKey[i].w.byte0 := BYTE(FpKey[j]); {MSB}{do this way so comp with PGP} - FEnCiKey[i].w.byte1 := BYTE(FpKey[j + 1]); - j := j + 2; -{ FEnCiKey[i].SWord := i +1; Test key} - end;{for} - -{ For j := 8 to (KEYLEN - 1) do begin - Inc(i); - pKey^[i + 7].SWord := (pKey^[i And 7].SWord SHL 9) Or (pKey^[i + 1 And 7].SWord SHR 7); - Inc(pKey, (i And 8)); - i := i And 7; - end;{for} - For i:= 8 to (KEYLEN - 1) do begin - if ((i And 7) < 6) then - FEnCiKey[i].SWord := ((FEnCiKey[i - 7].SWord And 127) SHL 9) Or (FEnCiKey[i - 6].SWord SHR 7) - else begin - if ((i And 7) = 6) then - FEnCiKey[i].SWord := ((FEnCiKey[i - 7].SWord And 127) SHL 9) Or (FEnCiKey[i - 14].SWord SHR 7) - else - FEnCiKey[i].SWord := ((FEnCiKey[i - 15].SWord And 127) SHL 9) Or (FEnCiKey[i - 14].SWord SHR 7); - end; - end;{for} -end;{TIDEA.IDEA_ExpandKey} - -Procedure TIDEA.IDEA_InvertKey; -var - i : WORD; - t1, t2, t3: UWORD16; - pDeKey, pCiKey: pUWORD16; - -begin - pCiKey := @FEnCiKey; {!!!!Expand_Key MUST have been called first!!!!} - pDeKey := @FDeCiKey; - Inc(pDeKey, KEYLEN); - t1 := INV(pCiKey); Inc(pCiKey); - t2 := 0 - pCiKey^; Inc(pCiKey); - t3 := 0 - PCiKey^; Inc(pCiKey); - Dec(pDeKey); pDeKey^ := INV(pCiKey); Inc(pCiKey); - Dec(pDeKey); pDeKey^ := t3; - Dec(pDeKey); pDeKey^ := t2; - Dec(pDeKey); pDeKey^ := t1; - for i := 1 to (FRounds -1) do begin - t1 := pCiKey^; Inc(pCiKey); - Dec(pDeKey); pDeKey^ := pCiKey^; Inc(pCiKey); - Dec(pDeKey); pDeKey^ := t1; - t1 := INV(pCiKey); Inc(pCiKey); - t2 := 0 - pCiKey^; Inc(pCiKey); - t3 := 0 - PCiKey^; Inc(pCiKey); - Dec(pDeKey); pDeKey^ := INV(pCiKey); Inc(pCiKey); - Dec(pDeKey); pDeKey^ := t2; - Dec(pDeKey); pDeKey^ := t3; - Dec(pDeKey); pDeKey^ := t1; - end;{for} - t1 := pCiKey^; Inc(pCiKey); - Dec(pDeKey); pDeKey^ := pCiKey^; Inc(pCiKey); - Dec(pDeKey); pDeKey^ := t1; - t1 := INV(pCiKey); Inc(pCiKey); - t2 := 0 - pCiKey^; Inc(pCiKey); - t3 := 0 - PCiKey^; Inc(pCiKey); - Dec(pDeKey); pDeKey^ := INV(pCiKey); Inc(pCiKey); - Dec(pDeKey); pDeKey^ := t3; - Dec(pDeKey); pDeKey^ := t2; - Dec(pDeKey); pDeKey^ := t1; -end;{TIDEA.IDEA_InvertKey} - -Procedure TIDEA.SetKeys; {Sets up En\DecipherKey SubKeys} -{var - i, j: integer; - dum: string;} -begin - {Convert a ascii string of 'hex' characters to hex values.} -{ j := 1; - for i:= 1 to 8 do begin - dum:= '$' + System.Copy(FKey, j, 2); - FpKey[i - 1] := char(StrToInt(dum)); - j := j + 2; - end;{for} - - StrPCopy(FpKey, FKey); - IDEA_ExpandKey;{Make Encipher Key} - IDEA_InvertKey;{Make Decipher Key} -end; - -Procedure TIDEA.IDEA_Cipher; {Enciphers 64bit block} -{IDEA CIPHER Alogrithm} -var - t2, t1: UWORD16; {Save these, for use in steps 11..14} - pKey: pUWORD16; - i : BYTE; -begin -pKey:= FCiKey; - {Flip bytes on Intel!!} - With FpActiveBlock^ do begin -{Intelx86, IDEA assumes BigEndian} - X1 := (X1 SHR 8) Or (X1 SHL 8); - X2 := (X2 SHR 8) Or (X2 SHL 8); - X3 := (X3 SHR 8) Or (X3 SHL 8); - X4 := (X4 SHR 8) Or (X4 SHL 8); - - for i:= 0 to (FRounds - 1) do begin - X1 := MUL(@X1, pKey); (*Step One 1*) Inc(pKey); - Inc(X2, pKey^); (*Step Two 2*) Inc(pKey); - Inc(X3, pKey^); (*Step Three 3*) Inc(pKey); - X4 := MUL(@X4, pKey); (*Step Four 4*) Inc(pKey); - - t2 := X3 Xor X1; (*Step Five 5*) - t1 := X2 Xor X4; (*Step Six 6*) - - t2 := MUL(@t2, pKey); (*Step Seven 7*) Inc(pKey); - Inc(t1, t2); (*Step Eight 8*) - t1 := MUL(@t1, pKey); (*Step Nine 9*) Inc(pKey); - Inc(t2, t1); (*Step Ten 10*) - - X1 := X1 Xor t1; (*Step Eleven 11*) - X4 := X4 Xor t2; (*Step Fourteen 14*) - t2 := t2 Xor X2; - X2 := X3 Xor t1; (*Step Twelve 12*) - X3 := t2; (*Step Thirteen 13*) - end;{for} - - X1 := MUL(@X1, pKey); Inc(pKey); - t2:= X2; - X2 := X3 + pKey^; Inc(pKey); - X3 := t2 + pKey^; Inc(pKey); - X4 := MUL(@X4, pKey); - X1 := (X1 SHR 8) Or (X1 SHL 8); - X2 := (X2 SHR 8) Or (X2 SHL 8); - X3 := (X3 SHR 8) Or (X3 SHL 8); - X4 := (X4 SHR 8) Or (X4 SHL 8); - end;{with FpActiveBlock^} -end;{TIDEA.IDEA_Encipher} - -Procedure TIDEA.EncipherBLOCK; -{Private procedure. Enciphers blocks of data pointed to by FInputArray.} -begin - FCiKey := @FEnCiKey; {Point to Encipher Key} - IDEA_Cipher; -end;{TIDEA.Encipher_Bytes} - -Procedure TIDEA.DecipherBLOCK; -begin - FCiKey := @FDeCiKey; {Point to Decipher Key} - IDEA_Cipher; -end;{TIDEA.Decipher_Bytes} -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/KeeperOpts.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/KeeperOpts.pas deleted file mode 100644 index 8624d3c2c46..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/KeeperOpts.pas +++ /dev/null @@ -1,65 +0,0 @@ -unit KeeperOpts; - -interface - -uses ElOpts, Classes; - -type - - TKeeperOpts = class(TElOptions) - private - FSaveKeys: Boolean; - FShowPassword: Boolean; - FKeepPassword: Boolean; - FLastFile: String; - FReopenFile: Boolean; - FToTray: Boolean; - FMinimizeOnEsc: Boolean; - FMinimizeOnClose: Boolean; - FCountFolderChanges: Boolean; - procedure SetShowPassword(newValue: Boolean); - public - constructor Create(AOwner: TComponent); override; - published - property ShowPassword: Boolean read FShowPassword write SetShowPassword default False; - property KeepPassword: Boolean read FKeepPassword write FKeepPassword; - property LastFile: String read FLastFile write FLastFile; - property ReopenFile: Boolean read FReopenFile write FReopenFile; - property ToTray: Boolean read FToTray write FToTray; - property SaveKeys: Boolean read FSaveKeys write FSaveKeys; - property MinimizeOnEsc: Boolean read FMinimizeOnEsc write FMinimizeOnEsc; - property MinimizeOnClose: Boolean read FMinimizeOnClose write FMinimizeOnClose - default false; - property CountFolderChanges: Boolean read FCountFolderChanges write - FCountFolderChanges; - end; - -var Options : TKeeperOpts; - -implementation - -uses LogoMain; - -constructor TKeeperOpts.Create(AOwner: TComponent); -begin - FShowPassword := False; - FCountFolderChanges := true; -end; - -procedure TKeeperOpts.SetShowPassword(newValue: Boolean); -begin - if (FShowPassword <> newValue) then - begin - FShowPassword := newValue; - if LogoAppForm <> nil then - with LogoAppForm do - begin - Tree.HeaderSections[4].Password := not newValue; - Tree.HeaderSections[3].Password := not newValue; - end; - end; {if} -end; - -end. - - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/KeyGen.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/KeyGen.pas deleted file mode 100644 index 977d92557ca..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/KeyGen.pas +++ /dev/null @@ -1,120 +0,0 @@ -unit KeyGen; - -interface - - function DecodeUName : string; - procedure Start; - -implementation - -uses - Windows, SysUtils, Classes, CryptCon, ElTools, ElStrUtils, IdeaUnit, MD5Unit; - -function DecodeUName : string; -var Stream : TFileStream; - FileName : string; - MD5 : TMD5; - MemStream : TStringStream; - arr : array [1..17] of char; - IDEA: TIDEA; - -begin - result := ''; - FileName := ExtractFilePath(ParamStr(0))+'ElKeeper.key.bin'; - if not FileExists(FileName) then exit; - - MD5:=TMD5.Create; - MD5.InputType:=SourceString; - MD5.InputString := 'EldoS Keeper'; - MD5.pOutputArray:= @arr; - MD5.MD5_Hash; - arr[17]:=#0; - MD5.Free; - try - MemStream := nil; - Stream := nil; - IDEA := nil; - try - MemStream := TStringStream.Create(''); - Stream :=TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - IDEA := TIDEA.Create(nil); - IDEA.InputType := SourceStream; - IDEA.CipherMode := ECBMode; - IDEA.IVector:='EldoS Keeper'; - IDEA.Key:=StrPas(@arr); - IDEA.InputStream:=Stream; - IDEA.OutputStream:=MemStream; - IDEA.DecipherData(False); - MemStream.Seek(0, soFromBeginning); - result := MemStream.DataString; - finally - IDEA.free; - MemStream.Free; - Stream.Free; - end; - except - end; -end; - -procedure Start; - -var UserName : string; -var Stream : TStream; - MD5 : TMD5; - MemStream : TStringStream; - arr : array [1..17] of char; - IDEA: TIDEA; - FileName : string; - S : string; - p : pointer; - i : integer; -begin - UserName := ParamStr(1); - FileName := ExtractFilePath(ParamStr(0))+'ElKeeper.key'; - MD5:=TMD5.Create; - MD5.InputType:=SourceString; - MD5.InputString:='EldoS Keeper'; - MD5.pOutputArray:=@arr; - MD5.MD5_Hash; - arr[17]:=#0; - MD5.Free; - MemStream := nil; - Stream := nil; - IDEA := nil; - try - MemStream := TStringStream.Create(UserName); - MemStream.Seek(0, soFromBeginning); - if FileExists(FileName) then DeleteFile(FileName); - Stream := TDirectMemoryStream.Create; - IDEA := TIDEA.Create(nil); - try - IDEA.InputType := SourceStream; - IDEA.CipherMode := ECBMode; - IDEA.IVector:='EldoS Keeper'; - IDEA.Key:=StrPas(@arr); - IDEA.InputStream := MemStream; - IDEA.OutputStream := Stream; - IDEA.EncipherData(False); - S := Data2Str(TDirectMemoryStream(Stream).Memory, Stream.Size); - Stream.Free; - - Stream := TFileStream.Create(Filename, fmCreate or fmShareDenyWrite); - WriteTextToStream(Stream, S); - Stream.Free; - Str2Data(S, p, i); - - DeleteFile(FileName + '.bin'); - Stream := TFileStream.Create(Filename + '.bin', fmCreate or fmShareDenyWrite); - Stream.WriteBuffer(Pchar(p)^, i); - Stream.Free; - finally - IDEA.free; - MemStream.Free; - writeln(output, 'The key was generated for ', DecodeUName); - end; - except - writeln('Failed to create a key'); - end; -end; - -end. \ No newline at end of file diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/LOGOSTRS.RES b/sdk/components/ElPack/BCBDemos/ElKeeper/LOGOSTRS.RES deleted file mode 100644 index cbcf98389b5..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/LOGOSTRS.RES and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/LogoMain.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/LogoMain.dfm deleted file mode 100644 index 62e1a9719fb..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/LogoMain.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/LogoMain.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/LogoMain.pas deleted file mode 100644 index b2b5529c280..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/LogoMain.pas +++ /dev/null @@ -1,2136 +0,0 @@ -{$INCLUDE DEFINE.INC} -unit LogoMain; - -interface - -uses Windows, Classes, Forms, Controls, Menus, CryptCon, - Dialogs, StdCtrls, Buttons, ExtCtrls, ElMTree, EntryData, ElHeader, - ElImgLst, ElStack, frmRecProp, About, ElMD5, IdeaUnit, ElTools, frmPassword, - ShellApi, Graphics, ClipBrd, Registry, KeeperOpts, ElPromptDlg, - ElStrUtils, ElTray, ElMRU, ElPopBtn, ElIni, ToolWin, frmFolderProp, - ElCaption, ElPanel, ElToolBar, ElBtnCtl, ElFrmPers, ElBaseComp, FrmOpts, - ElShutdownWatcher, ElACtrls, ElTree, ElAES, Messages, ImgList, - ElXPThemedControl; - -type - TLogoAppForm = class(TForm) - MainMenu: TMainMenu; - FileMenu: TMenuItem; - FileNewItem: TMenuItem; - FileOpenItem: TMenuItem; - FileSaveItem: TMenuItem; - FileExitItem: TMenuItem; - OpenDialog: TOpenDialog; - SaveDialog: TSaveDialog; - Help1: TMenuItem; - AboutItem: TMenuItem; - CloseBtn: TMenuItem; - PopupMenu: TPopupMenu; - NewFoldItem: TMenuItem; - NewRecItem: TMenuItem; - DeleteItem: TMenuItem; - N1: TMenuItem; - N3: TMenuItem; - PropItem: TMenuItem; - ElImgList: TElImageList; - Record1: TMenuItem; - Newfolder1: TMenuItem; - Newrecord1: TMenuItem; - N4: TMenuItem; - Delete1Item: TMenuItem; - N5: TMenuItem; - Prop1Item: TMenuItem; - ContentsItem: TMenuItem; - N6: TMenuItem; - N7: TMenuItem; - RecentItem: TMenuItem; - GoItem: TMenuItem; - Go1Item: TMenuItem; - CopyItem: TMenuItem; - PrintSetDlg: TPrinterSetupDialog; - PrintSetupItem: TMenuItem; - PrintItem: TMenuItem; - PrintDlg: TPrintDialog; - Tray: TElTrayIcon; - ElMRU: TElMRU; - RecentPopup: TPopupMenu; - ElIniFile: TElIniFile; - ElFormPersist: TElFormPersist; - PasswItem: TMenuItem; - FormCaption: TElFormCaption; - CopyPswItem: TMenuItem; - SetPswItem: TMenuItem; - Go2Item: TMenuItem; - Go3Item: TMenuItem; - N9: TMenuItem; - miCopyUsername: TMenuItem; - miCopyAccount: TMenuItem; - SuggestItem: TMenuItem; - Timer1: TTimer; - N10: TMenuItem; - ContactUs1: TMenuItem; - TellafriendItem: TMenuItem; - RegisterItem: TMenuItem; - HomepageItem: TMenuItem; - TrayMenu: TPopupMenu; - miShowQuickAccess: TMenuItem; - Exit1: TMenuItem; - N11: TMenuItem; - miCheckCompat: TMenuItem; - N12: TMenuItem; - miTools: TMenuItem; - ToolBar: TElToolBar; - ExitBtn: TElToolButton; - NewBtn: TElToolButton; - ElToolButton3: TElToolButton; - OpenBtn: TElToolButton; - SaveBtn: TElToolButton; - PrintBtn: TElToolButton; - ElToolButton2: TElToolButton; - NewFolderBtn: TElToolButton; - NewRecBtn: TElToolButton; - ElToolButton6: TElToolButton; - DelBtn: TElToolButton; - PropBtn: TElToolButton; - ElToolButton1: TElToolButton; - GoBtn: TElToolButton; - CopyBtn: TElToolButton; - Go2Btn: TElToolButton; - CopyUNameBtn: TElToolButton; - CopyAcctBtn: TElToolButton; - CopyPswBtn: TElToolButton; - QuickAccessBtn: TElToolButton; - ElToolButton5: TElToolButton; - Tree: TElTree; - ElImgList1: TElImageList; - miSaveAttach: TMenuItem; - AttachSaveDlg: TSaveDialog; - miExport: TMenuItem; - ExportDialog: TSaveDialog; - miShowMainWin: TMenuItem; - N8: TMenuItem; - OptionsItem: TMenuItem; - ColumnsItem: TMenuItem; - procedure FormCreate(Sender: TObject); - procedure FileExit(Sender: TObject); - procedure FileNew(Sender: TObject); - procedure FileOpen(Sender: TObject); - procedure FileSave(Sender: TObject); - procedure FileSaveAs(Sender: TObject); - procedure About(Sender: TObject); - procedure CloseBtnClick(Sender: TObject); - procedure TreeMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure NewFoldItemClick(Sender: TObject); - procedure PropItemClick(Sender: TObject); - procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); - procedure DeleteItemClick(Sender: TObject); - procedure NewRecItemClick(Sender: TObject); - procedure TreeStartDrag(Sender: TObject; - var DragObject: TDragObject); - procedure TreeDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); - procedure TreeDragDrop(Sender, Source: TObject; X, Y: Integer); - procedure Record1Click(Sender: TObject); - procedure TreeItemFocused(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure ContentsItemClick(Sender: TObject); - function AppEventsHelp(Command: Word; Data: Integer; - var CallHelp: Boolean): Boolean; - procedure GoItemClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure CopyBtnClick(Sender: TObject); - procedure PrintSetupItemClick(Sender: TObject); - procedure PrintItemClick(Sender: TObject); - procedure TrayDblClick(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure PasswItemClick(Sender: TObject); - procedure ElMRUClick(Sender: TObject; Entry: TElMRUEntry); - procedure FormCaptionButtonClick(Sender: TObject; - Button: TElCaptionButton); - procedure CopyPswItemClick(Sender: TObject); - procedure ElFormPersistRestore(Sender: TObject); - procedure SetPswItemClick(Sender: TObject); - procedure Go2BtnClick(Sender: TObject); - procedure miCopyUsernameClick(Sender: TObject); - procedure miCopyAccountClick(Sender: TObject); - procedure SuggestItemClick(Sender: TObject); - procedure Timer1Timer(Sender: TObject); - procedure TellafriendItemClick(Sender: TObject); - procedure RegisterItemClick(Sender: TObject); - procedure HomepageItemClick(Sender: TObject); - procedure TreeItemPicDraw(Sender: TObject; Item: TElTreeItem; - var ImageIndex: Integer); - procedure QuickAccessBtnClick(Sender: TObject); - procedure TreeItemExpand(Sender: TObject; Item: TElTreeItem); - procedure TreeItemCollapse(Sender: TObject; Item: TElTreeItem); - procedure Exit1Click(Sender: TObject); - procedure miShowQuickAccessClick(Sender: TObject); - procedure miCheckCompatClick(Sender: TObject); - procedure TreeHeaderColumnDraw(Sender: TCustomElHeader; Canvas : TCanvas; - Section: TElHeaderSection; R: TRect; Pressed: Boolean); - procedure TreeItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); - procedure miSaveAttachClick(Sender: TObject); - procedure miExportClick(Sender: TObject); - procedure TreeSortEnd(Sender: TObject); - procedure FormKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure OptionsItemClick(Sender: TObject); - procedure TreeHeaderLookup(Sender: TObject; Section: TElHeaderSection; - var Text: String); - procedure ColumnsItemClick(Sender: TObject); - procedure TreeScroll(Sender: TObject; ScrollBarKind: TScrollBarKind; - ScrollCode: Integer); - private - FFileName: string; - FOpened: Boolean; - DragItem : TElTreeItem; - FModified : boolean; - AMinimized : boolean; - hMapping : THandle; - JustStarted : boolean; - DoExit : boolean; - FModified2: Boolean; - function FileClose : boolean; - function SaveFile(AFileName : string): Boolean; - function LoadFile(AFileName, Passw : string; UseGivenPassword : boolean): - Boolean; - procedure OnItemDelete(Sender : TObject; Item : TElMTreeItem; Data : pointer); - procedure CreateRecord(IsFolder : boolean); - procedure OnItemSave(Sender : TObject; Item : TElMTreeItem; Stream : TStream); - procedure OnItemLoad(Sender : TObject; Item : TElMTreeItem; Stream : TStream); - procedure UpdateItem(Item : TElTreeItem); - procedure SetModified(Value : boolean); - procedure SetModified2(Value: Boolean); - procedure SetFileName(const Value: string); - procedure SetOpened(Value: Boolean); - procedure AppEventsIdle(Sender : TObject; var Done: Boolean); - procedure AppEventsMinimize(Sender: TObject); - procedure AppEventsRestore(Sender: TObject); - procedure RestoreFontSettings; - protected - procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND; - public - MVis, - QVis : boolean; - FilePassword : string; - - function GetSelItem : TElTreeItem; - function PropsEdit(Item : TElTreeItem) : Boolean; - function GetDataIndex(Data : Pointer) : integer; - - property Modified : boolean read FModified write SetModified; - property SelItem : TElTreeItem read GetSelItem; - property FileName : string read FFileName write SetFileName; - property Opened : Boolean read FOpened write SetOpened; - property Modified2: Boolean read FModified2 write SetModified2; - end; - -var - LogoAppForm: TLogoAppForm; - -const - hsiAttachment = 9; - -implementation - -uses SysUtils, LogoStrs, Printers, ElOpts, frmQuickAccess; - -{$R *.DFM} - -function TLogoAppForm.GetSelItem : TElTreeItem; -begin - result := Tree.ItemFocused; -end; - -procedure TLogoAppForm.SetModified(Value : boolean); -begin - if FModified <> Value then - begin - FModified := Value; - SaveBtn.Enabled := Modified2 or Value; - FileSaveItem.Enabled := Modified2 or Value; - end; -end; - -procedure TLogoAppForm.RestoreFontSettings; -var S : String; - c : integer; - size : integer; - St : TFontStyles; - bl : integer; -begin - if ElIniFile.ReadString('\', 'FontName', '', S) then - begin - Tree.Font.Name := S; - QuickAccessForm.Tree.Font.Name := S; - end; - if ElIniFile.ReadInteger('\', 'FontCharset', 0, c) then - begin - Tree.Font.Charset := c; - QuickAccessForm.Tree.Font.Charset := c; - end; - if ElIniFile.ReadInteger('\', 'FontSize', 0, size) then - begin - Tree.Font.Size := size; - QuickAccessForm.Tree.Font.Size := size; - end; - bl := sizeof(st); - if ElIniFile.ReadBinary( '\', 'FontStyles', st, bl) then - begin - Tree.Font.Style := st; - QuickAccessForm.Tree.Font.Style := st; - end; -end; - -procedure TLogoAppForm.FormCreate(Sender: TObject); -var S : String; -begin - Options := TKeeperOpts.Create(Self); - Options.Storage := ElIniFile; - Options.StorageType := eosElIni; - Options.Load; - S := Tree.HeaderSections.SectionsOrder; - if ElIniFile.ReadString('\LogoAppForm\Tree\ElHeader', 'Order', S, S) then - Tree.HeaderSections.SectionsOrder := S; - Tree.Restore; - ElMRU.Restore; - Tree.HeaderSections[9].ShowSortMark := false; - - if Options.ShowPassword then - PasswItem.Checked := true; - - Application.OnHelp := AppEventsHelp; - Application.OnRestore := Self.AppEventsRestore; - Application.OnMinimize := Self.AppEventsMinimize; - Application.OnIdle := AppEventsIdle; - FMTree := TElMTree.Create; - FMTree.OnItemDelete:=OnItemDelete; - FMTree.OnItemSave:=OnItemSave; - FMTree.OnItemLoad:=OnItemLoad; - LoadStack:=TElStack.Create; - Opened := false; - AboutBox:=TAboutBox.Create(Self); - if OpenDialog.InitialDir='' then - OpenDialog.InitialDir := ExtractFileDir(ParamStr(0)); - if SaveDialog.InitialDir='' then - SaveDialog.InitialDir := ExtractFileDir(ParamStr(0)); - begin - NewFolderBtn.Visible := true; - NewRecBtn.Visible := true; - NewRecord1.Visible := true; - NewFolder1.Visible := true; - DelBtn.Visible := true; - Delete1Item.Visible := true; - NewFoldItem.Visible := true; - NewRecItem.Visible := true; - DeleteItem.Visible := true; - end; - hMapping := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, MAX_PATH + 1, 'EldoS Keeper current file name'); - FileName := LoadStr(sUntitled); - AssignedID := 0; - JustStarted := true; -end; - -procedure TLogoAppForm.FileNew(Sender: TObject); -begin - if Opened then - if not FileClose then exit; - Tree.Items.Clear; - FMTree.Clear; - DeleteItem.Enabled := false; - PropItem.Enabled := false; - Delete1Item.Enabled := false; - Prop1Item.Enabled := false; - GoItem.Enabled := false; - GoBtn.Enabled := false; - Go1Item.Enabled := false; - PropBtn.Enabled := false; - DelBtn.Enabled :=false; - CopyBtn.Enabled := false; - CopyItem.Enabled := false; - //SelItem := nil; - Modified := false; - Modified2 := false; - Opened := true; - FilePassword := ''; - AssignedID := 0; - FileName := LoadStr(sUntitled); - QuickAccessForm.UpdateTree(FMTree); - Tree.BkColor := clWindow; - Tree.ShowColumns := true; -end; - -procedure TLogoAppForm.FileOpen(Sender: TObject); -begin - if OpenDialog.Execute then - begin - if Opened then - if not FileClose then - exit; - if LoadFile(OpenDialog.FileName, '', false) then - begin - FileName := OpenDialog.FileName; - //SelItem := nil; - Modified:= false; - Opened := true; - end; - end; -end; - -procedure TLogoAppForm.FileSave(Sender: TObject); -begin - if FileName = LoadStr(sUntitled) then - FileSaveAs(Sender) - else - if SaveFile(FileName) then - begin - Modified := false; - Modified2 := false; - end; -end; - -procedure TLogoAppForm.FileSaveAs(Sender: TObject); -begin - if SaveDialog.Execute then - begin - if FileExists(SaveDialog.FileName) then - if ElMessageDlg(FmtLoadStr(sOverwrite, [SaveDialog.FileName]), - mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit; - if SaveFile(SaveDialog.FileName) then - begin - FileName := SaveDialog.FileName; - Options.LastFile := FileName; - Modified := false; - Modified2 := false; - ElMRU.Sections[0].Add(FileName, 0); - end; - end; -end; - -function TLogoAppForm.FileClose; -begin - result := true; - if not Opened then exit; - if Modified then - begin - case ElMessageDlg(LoadStr(sSaveOnCLose), mtWarning, [mbYes, mbNo, mbCancel], 0) of - id_Yes: begin - FileSave(Self); - if Modified then result:=false; - end; - id_No: begin - Modified := false; - Modified2 := false; - end; - id_Cancel: result:=false; - end; - end; - if Result then - begin - Opened := false; - Tree.Items.Clear; - FMTree.Clear; - FilePassword := ''; - FileName := LoadStr(sUntitled); - end; -end; - -procedure TLogoAppForm.FileExit(Sender: TObject); -begin - DoExit := true; - Close; -end; - -procedure TLogoAppForm.About(Sender: TObject); -begin - AboutBox.ShowModal; -end; - -function TLogoAppForm.SaveFile(AFileName : string): Boolean; - - function SaveEK3(Password : string) : boolean; - var AESKey, - KeyHash : array [1..17] of char; - MemStream : TDirectMemoryStream; - Stream : TStream; - MD5 : TCrMD5; - S : string; - begin - MD5:=TCrMD5.Create; - try - MD5.InputType := SourceString; - MD5.InputString := Password; - MD5.pOutputArray := @AESKey; - MD5.MD5_Hash; - AESKey[17]:=#0; - finally - MD5.Free; - end; - MD5:=TCrMD5.Create; - try - MD5.InputType := SourceByteArray; - MD5.pInputArray := @AESKey; - MD5.InputLength := 16; - MD5.pOutputArray := @KeyHash; - MD5.MD5_Hash; - finally - MD5.Free; - end; - MemStream := TDirectMemoryStream.Create; - try - MemStream.WriteBuffer(KeyHash, Sizeof(KeyHash)); - - FileVersion := FILE_VERSION; - MemStream.WriteBuffer(FileVersion, sizeof(integer)); - MemStream.WriteBuffer(AssignedID, sizeof(AssignedID)); - - FMTree.SaveToStream(MemStream); - FileVersion := 0; - MemStream.Seek(0, soFromBeginning); - try - Stream := TFileStream.Create(AFileName, fmCreate or fmShareDenyWrite); - except - Stream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite); - end; - try - S := AESEncrypt(MemStream.Memory, MemStream.Size, @AESKey); - Stream.WriteBuffer(PChar(S)[0], Length(S)); - finally - Stream.Free; - end; - finally - MemStream.Free; - end; - result := true; - end; - - function SaveEK2(Password : string) : boolean; - var key : array [1..17] of char; - MemStream : TDirectMemoryStream; - Stream : TStream; - MD5 : TCrMD5; - IDEA : TIDEA; - begin - - MD5:=TCrMD5.Create; - try - MD5.InputType := SourceString; - MD5.InputString := Password; - MD5.pOutputArray := @key; - MD5.MD5_Hash; - key[17]:=#0; - finally - MD5.Free; - end; - MemStream := TDirectMemoryStream.Create; - try - try - FMTree.SaveToStream(MemStream); - MemStream.Seek(0, soFromBeginning); - if FileExists(AFileName) then - Stream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite) - else - Stream := TFileStream.Create(AFileName, fmCreate or fmShareDenyWrite); - try - IDEA := TIDEA.Create(self); - try - IDEA.InputType := SourceStream; - IDEA.CipherMode := ECBMode; - IDEA.IVector := Password; - IDEA.Key := StrPas(@key); - IDEA.InputStream := MemStream; - IDEA.OutputStream:= Stream; - IDEA.EncipherData(False); - finally - IDEA.free; - end; - finally - Stream.Free; - end; - Modified := false; - Modified2 := false; - except - on E : Exception do - begin - ElMessageDlg(FmtLoadStr(sFailSave, [AFileName]), mtError, [mbOk], 0); - result := false; - exit; - end; - end; - finally - MemStream.Free; - end; - result := true; - end; - -var Passw : string; - -begin - PasswordDlg.Password.Text:=''; - PasswordDlg.ConfPassword.visible:=true; - PasswordDlg.ConfLabel.Visible:=true; - PasswordDlg.ConfPassword.Text:=''; - result:=false; - if (not Options.KeepPassword) or (FilePassword = '') then - begin - repeat - if PasswordDlg.ShowModal = mrCancel then - exit; - if PasswordDlg.Password.Text<>PasswordDlg.ConfPassword.Text then - ElMessageDlg (LoadStr(sPswNotMatch), mtError, [mbOk], 0) - else - if PasswordDlg.Password.Text='' then - ElMessageDlg (LoadStr(sPswEmpty), mtError, [mbOk], 0) - else - break; - until false; - Passw := PasswordDlg.Password.Text; - PasswordDlg.Password.Text:=''; - PasswordDlg.ConfPassword.Text:=''; - end - else - Passw := FilePassword; - - if lowercase(ExtractFileExt(AFileName)) = '.ek3' then - result := SaveEK3(Passw) - else - result := SaveEK2(Passw); -end; { SaveFile } - -function TLogoAppForm.LoadFile(AFileName, Passw : string; UseGivenPassword : - boolean): Boolean; - - function LoadEK3 : boolean; - var Stream : TFileStream; - MD5 : TCrMD5; - MemStream : TDirectMemoryStream; - AESKey, - KeyHash, - SigHash: array [1..17] of char; - S : string; - - begin - result := false; - MD5:=TCrMD5.Create; - try - MD5.InputType := SourceString; - MD5.InputString := Passw; - MD5.pOutputArray:= @AESKey; - MD5.MD5_Hash; - finally - MD5.Free; - end; - MD5:=TCrMD5.Create; - try - AESKey[17] :=#0; - MD5.InputType := SourceByteArray; - MD5.pInputArray := @AESKey; - MD5.InputLength := 16; - MD5.pOutputArray:= @KeyHash; - MD5.MD5_Hash; - finally - MD5.Free; - end; - - MemStream := TDirectMemoryStream.Create; - try - Stream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); - MemStream.CopyFrom(Stream, Stream.Size); - try - if Passw <> '' then - begin - S := AESDecrypt(MemStream.Memory, MemStream.Size, @AESKey); - MemStream.Size := Length(S); - MoveMemory(MemStream.Memory, PChar(S), Length(S)); - S := ''; - MemStream.Position := 0; - MemStream.ReadBuffer(SigHash, sizeof(SigHash)); - end - else - begin - MemStream.ReadBuffer(SigHash, Sizeof(SigHash)); - end; - if not CompareMem(@SigHash[1], @KeyHash[1], 16) then - begin - result := false; - raise Exception.Create('Failed to open the file:'#13#10'The password is incorrect or the file is corrupt.'); - end; - - FMTree.Clear; - - MemStream.ReadBuffer(FileVersion, sizeof(Integer)); - if FileVersion >= 4 then - MemStream.ReadBuffer(AssignedID, sizeof(AssignedID)) - else - AssignedID := 0; - try - Tree.Items.BeginUpdate; - try - FMTree.LoadFromStream(MemStream); - result := true; - finally - Tree.Items.EndUpdate; - QuickAccessForm.UpdateTree(FMTree); - end; - FileVersion := 0; - except - on E: EReadError do - Raise Exception.Create('Failed to open the file: file seems to be corrupt.'); - end; - finally - Stream.Free; - end; - finally - MemStream.Free; - end; - end; - - - function LoadEK2 : boolean; - var Stream : TFileStream; - MD5 : TCrMD5; - MemStream : TDirectMemoryStream; - arr : array [1..17] of char; - IDEA: TIDEA; - begin - MD5:=TCrMD5.Create; - MD5.InputType:=SourceString; - MD5.InputString:=Passw; - MD5.pOutputArray:=@arr; - MD5.MD5_Hash; - arr[17]:=#0; - MD5.Free; - MemStream := nil; - Stream := nil; - try - MemStream := TDirectMemoryStream.Create; - Stream :=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); - if Passw<>'' then - begin - IDEA := nil; - try - IDEA := TIDEA.Create(self); - IDEA.InputType := SourceStream; - IDEA.CipherMode := ECBMode; - IDEA.IVector:=Passw; - - IDEA.Key:=StrPas(@arr); - IDEA.InputStream:=Stream; - IDEA.OutputStream:=MemStream; - IDEA.DecipherData(False); - MemStream.Seek(0, soFromBeginning); - - FMTree.Clear; - Tree.Items.Clear; - - Tree.Items.BeginUpdate; - try - FMTree.LoadFromStream(MemStream); - result := true; - finally - Tree.Items.EndUpdate; - QuickAccessForm.UpdateTree(FMTree); - end; - finally - IDEA.free; - end; - end - else - try - FMTree.LoadFromStream(Stream); - result := true; - finally - QuickAccessForm.UpdateTree(FMTree); - end; - MemStream.Free; - Stream.Free; - except - on E:Exception do - begin - ElMessageDlg(FmtLoadStr(sFailLoad, [AFileName]), mtError, [mbOk], 0); - - FMTree.Clear; - Tree.Items.Clear; - - MemStream.Free; - Stream.Free; - - result := false; - exit; - - end; - end; - end; - -var hMapping : THandle; - View : Pointer; - b : boolean; - -begin - result:=False; - b := false; - if not (FileExists(AFileName)) then exit; - hMapping := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, MAX_PATH + 1, 'EldoS Keeper current file name'); - if (hMapping <> 0) then - begin - View := MapViewOfFile(hMapping, FILE_MAP_WRITE, 0, 0, MAX_PATH + 1); - if (View <> nil) then - begin - if AnsiCompareText(AFileName, StrPas(PChar(View))) = 0 then - b := true; - UnmapViewOfFile(View); - end; - CloseHandle(hMapping); - end; - if b then - ElMessageDlg('This file is currently opened with PDA synchronization module.'#13#10'Please try to open this file a little later.', mtInformation, [mbOk], 0); - - if not UseGivenPassword then - begin - PasswordDlg.Password.Text:=''; - PasswordDlg.ConfPassword.visible:=false; - PasswordDlg.ConfLabel.Visible:=false; - PasswordDlg.ConfPassword.Text:=''; - if PasswordDlg.ShowModal = mrCancel then exit; - Passw := PasswordDlg.Password.Text; - PasswordDlg.Password.Text:=''; - end; - result := false; - Tree.Items.Clear; - - if lowercase(ExtractFileExt(AFileName)) = '.ek3' then - try - result := LoadEK3; - except - on E : Exception do - ElMessageDlg(E.Message, mtError, [mbOk], 0); - end - else - result := LoadEK2; - - if not result then - exit; - - ElMRU.Sections[0].Add(AFileName, 0); - if result then - begin - Options.LastFile := AFileName; - FilePassword := Passw; - end; -end; - -procedure TLogoAppForm.CloseBtnClick(Sender: TObject); -begin - if FileClose then - begin - GoItem.Enabled := false; - GoBtn.Enabled := false; - Go1Item.Enabled := false; - DeleteItem.Enabled := false; - PropItem.Enabled := false; - Delete1Item.Enabled := false; - Prop1Item.Enabled := false; - PropBtn.Enabled := false; - DelBtn.Enabled := false; - CopyBtn.Enabled := false; - CopyItem.Enabled := false; - //SelItem := nil; - Modified := false; - Modified2 := false; - QuickAccessForm.UpdateTree(FMTree); - end; -end; - -procedure TLogoAppForm.OnItemDelete(Sender : TObject; Item : TElMTreeItem; Data : pointer); -var E : PEntryRec; -begin - E:=PEntryRec(Data); - Dispose(E); -end; - -procedure TLogoAppForm.TreeMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - if Button = mbRight then - begin - //SelItem := ElTree.ItemFocused; - DeleteItem.Enabled := SelItem<>nil; - PropItem.Enabled := SelItem<>nil; - Delete1Item.Enabled := SelItem <>nil; - Prop1Item.Enabled := SelItem <>nil; - PropBtn.Enabled := SelItem <>nil; - DelBtn.Enabled := SelItem <>nil; - GoItem.Enabled := SelItem <>nil; - Go1Item.Enabled := SelItem <>nil; - GoBtn.Enabled := SelItem <>nil; - CopyBtn.Enabled := SelItem <>nil; - CopyItem.Enabled := SelItem <>nil; - end; -end; - -procedure TLogoAppForm.NewFoldItemClick(Sender: TObject); -begin - CreateRecord(true); -end; - -procedure TLogoAppForm.CreateRecord(IsFolder : boolean); -var Item, - Item1 : TElTreeItem; - MItem : TElMTreeItem; - Entry : PEntryRec; -begin - Tree.Items.BeginUpdate; - try - New(Entry); - FillMemory(Entry, sizeof(TEntryRec), 0); - if (SelItem <> nil) then - begin - if (PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Group) then - Item1 := SelItem - else - Item1 := SelItem.Parent; - Item := Tree.Items.AddItem(Item1); - Item.Expanded := false; - if Item1 <> nil then - Item1.Expanded := true; - if Item1 = nil then - begin - MItem := FMTree.AddItem(nil, Entry); - Entry.ParentID := DWORD(-1); - end - else - begin - Entry.ParentID := PEntryRec(Item1.Data).RecID; - MItem := FMTree.AddItem(Item1.Data, Entry); - end; - end - else - begin - Item := Tree.Items.AddItem(nil); - Item.Expanded := false; - MItem := FMTree.AddItem(nil, Entry); - Entry.ParentID := DWORD(-1); - end; - Item.Data := MItem; - Entry^.Group := IsFolder; - Entry.Added := Now; - Entry.Modified := Now; - Entry.Expires := Now + 30; - Entry.WarnDays := 1; - Entry.RecID := UniqueID; - Tree.ItemFocused := Item; - if not PropsEdit(SelItem) then - begin - FMTree.DeleteItem(MItem); - Tree.Items.DeleteItem(SelItem); - end - else - begin - Modified := true; - Opened := true; - UpdateItem(Item); - QuickAccessForm.UpdateTree(FMTree); - TreeItemFocused(self); - end; - finally - Tree.Items.EndUpdate; - end; -end; - -procedure TLogoAppForm.PropItemClick(Sender: TObject); -begin - if PropsEdit(SelItem) then - begin - QuickAccessForm.UpdateTree(FMTree); - TreeItemFocused(self); - end; -end; - -procedure TLogoAppForm.OnItemSave(Sender : TObject; Item : TElMTreeItem; Stream : TStream); { protected } -begin - DoItemSave(Item, Stream); -end; { OnItemSave } - -procedure TLogoAppForm.OnItemLoad(Sender : TObject; Item : TElMTreeItem; Stream : TStream); { protected } -var - VItem, Parent : TElTreeItem; - Entry : PEntryRec; - -begin - try - DoItemLoad(Item, Stream); - Entry := PEntryRec(Item.Data); - Parent := nil; - if not LoadStack.Empty then - begin - Parent := TElTreeItem(LoadStack.Pop); - if Parent.Data<>Item^.Parent then - begin - while (not LoadStack.Empty) do - begin - Parent := TElTreeItem(LoadStack.Pop); - if Parent.Data=Item^.Parent then - begin - LoadStack.Push(Parent); - break; - end; - end; - if LoadStack.Empty then Parent := nil; - end - else - LoadStack.Push(Parent); - end; - if Parent<>nil then - begin - VItem := Tree.Items.AddItem(Parent); - VItem.Data := Item; - end else - begin - VItem := Tree.Items.AddItem(nil); - VItem.Data := Item; - end; - Item^.Data := Entry; - LoadStack.Push(VItem); - - UpdateItem(VItem); - - VItem.Expanded := Entry.Expanded; - except - on E : Exception do - begin - Item.Data := nil; - raise; - end; - end; -end; { OnItemLoad } - -procedure TLogoAppForm.FormCloseQuery(Sender: TObject; - var CanClose: Boolean); -begin - if Options.MinimizeOnClose and (not DoExit) then - CanClose := true - else - CanClose := FileClose; -end; - -procedure TLogoAppForm.DeleteItemClick(Sender: TObject); -begin - if (SelItem = nil) or (SelItem.Data = nil) then exit; - if ElMessageDlg(LoadStr(sConfDelete), mtWarning, [mbYes, mbNo], 0)=mrNo then exit; - FMTree.DeleteItem(TElMTreeItem(SelItem.Data)); - Tree.Items.DeleteItem(SelItem); - Modified := true; - QuickAccessForm.UpdateTree(FMTree); - //SelItem := nil; -end; - -procedure TLogoAppForm.NewRecItemClick(Sender: TObject); -begin - CreateRecord(false); -end; - -procedure TLogoAppForm.UpdateItem(Item : TElTreeItem); -var Entry : PEntryRec; - s : string; -begin - if Item.Data=nil then exit; - Entry := PEntryRec(TElMTreeItem(Item.Data)^.Data); - - Tree.IsUpdating := true; - try - Item.Text:=Entry^.Site; - Item.ColumnText.Clear; - Item.ColumnText.Add(Entry^.Location); - if not Entry^.Group then - begin - Item.ColumnText.Add(Entry^.UName); - Item.ColumnText.Add(Entry^.Acct); - Item.ColumnText.Add(Entry^.Pswd); - Item.ColumnText.Add(Entry^.Info); - try - S := DateToStr(Entry^.Added); - except - S := DateToStr(Now); - end; - Item.ColumnText.Add(S); - - try - S := DateToStr(Entry^.Modified); - except - S := DateToStr(Now); - end; - Item.ColumnText.Add(S); - - try - S := DateToStr(Entry^.Expires); - except - S := DateToStr(Now + 1); - end; - Item.ColumnText.Add(S); - end; - - Item.ImageIndex := -1; - Item.StateImageIndex := -1; - - { - if Entry^.Group then - begin - Item.ImageIndex:=0; - Item.StateImageIndex := 1; - end - else - Item.ImageIndex := 2; - } - finally - Tree.IsUpdating:=false; - end; -end; - -function TLogoAppForm.PropsEdit(Item : TElTreeItem) : Boolean; { public } -begin - result :=false; - if (SelItem = nil) or (SelItem.Data = nil) then exit; - if PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Group then - begin - with TFolderPropsForm.Create(Self) do - begin - SiteNameEdit.Text := PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Site; - if ShowModal = mrOk then - begin - Modified := true; - SelItem.Text := SiteNameEdit.Text; - PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Site := SiteNameEdit.Text; - result := true; - end; - Free; - end; - end else - begin - with TRecPropsForm.Create(Self) do - begin - try - Entry := PEntryRec(TElMTreeItem(Self.SelItem.Data)^.Data); - SetData; - if ShowModal = mrOk then - begin - GetData; - Self.UpdateItem(SelItem); - Self.Modified := true; - result := true; - end; - finally - Free; - end; - end; - end; -end; { PropsEdit } - -type TElDragObject = class (TDragControlObject) - function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override; - end; - -function TElDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; -begin - if Control is TElTree then - begin - if ((Control as TElTree).GetItemAtY(Y)<>nil) or (Accepted) then - Result := (Control as TElTree).DragCursor else - Result := crNoDrop; - end else result:=inherited GetDragCursor(Accepted,X,Y); -end; - -procedure TLogoAppForm.TreeStartDrag(Sender: TObject; - var DragObject: TDragObject); -begin - DragItem := Tree.ItemFocused; - DragObject := TElDragObject.Create(Tree); -end; - -procedure TLogoAppForm.TreeDragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); -var TSI:TElTreeItem; -begin - Accept:=false; - if Source.ClassType <> TElDragObject then exit; - TSI := Tree.GetItemAtY(Y); - if TSI = nil then - begin - Accept:=true; - exit; - end; - if ((not TSI.IsUnder(DragItem)) and (PEntryRec(TElMTreeItem(TSI.Data)^.Data)^.Group)) then - Accept:=true; -end; - -procedure TLogoAppForm.TreeDragDrop(Sender, Source: TObject; X, - Y: Integer); -var TSI :TElTreeItem; -begin - TSI := Tree.GetItemAtY(Y); - if ((TSI<>nil) and (not TSI.IsUnder(DragItem)) and - (PEntryRec(TElMTreeItem(TSI.Data)^.Data)^.Group)) or - (TSI = nil) then - begin - DragItem.MoveTo(TSI); - if TSI <> nil then - FMTree.MoveTo(TElMTreeItem(DragItem.Data), TElMTreeItem(TSI.Data)) - else - FMTree.MoveTo(TElMTreeItem(DragItem.Data), nil); - Modified := true; - QuickAccessForm.UpdateTree(FMTree); - end; - DragItem := nil; -end; - -procedure TLogoAppForm.Record1Click(Sender: TObject); -begin - //SelItem := ElTree.ItemFocused; - DeleteItem.Enabled := SelItem <> nil; - PropItem.Enabled := SelItem <> nil; - Delete1Item.Enabled := SelItem<> nil; - Prop1Item.Enabled := SelItem<> nil; - PropBtn.Enabled := SelItem <> nil; - DelBtn.Enabled := SelItem <> nil; - GoItem.Enabled := SelItem <> nil; - Go1Item.Enabled := SelItem <> nil; - GoBtn.Enabled := SelItem <> nil; - CopyBtn.Enabled := SelItem <> nil; - CopyItem.Enabled := SelItem<> nil; -end; - -procedure TLogoAppForm.TreeItemFocused(Sender: TObject); -var IsRecord : boolean; -begin - if (csDestroying in ComponentState) then exit; - - DeleteItem.Enabled := SelItem<>nil; - PropItem.Enabled := SelItem<>nil; - Delete1Item.Enabled := SelItem <>nil; - Prop1Item.Enabled := SelItem <>nil; - DelBtn.Enabled := SelItem <>nil; - PropBtn.Enabled := SelItem <>nil; - CopyBtn.Enabled := SelItem <>nil; - CopyItem.Enabled := SelItem <>nil; - IsRecord := (SelItem <>nil) and - (TElMTreeItem(SelItem.Data)^.Data <> nil) and - (not PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Group); - - GoBtn.Enabled := IsRecord and (Length(PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Location) > 0); - GoItem.Enabled := GoBtn.Enabled; - Go1Item.Enabled := GoBtn.Enabled; - Go2Btn.Enabled := IsRecord and (Length(PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Location2) > 0); - Go2Item.Enabled := Go2Btn.Enabled; - - miCopyUsername.Enabled := IsRecord and (Length(PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.UName) > 0); - CopyUNameBtn.Enabled := miCopyUsername.Enabled; - - miCopyAccount.Enabled := IsRecord and (Length(PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Acct) > 0); - CopyAcctBtn.Enabled := miCopyAccount.Enabled; - - CopyPswItem.Enabled := IsRecord and (Length(PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Pswd) > 0); - CopyPswBtn.Enabled := CopyPswItem.Enabled; - - miSaveAttach.Enabled := IsRecord and - (PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.BinDataSize > 0); -end; - -procedure TLogoAppForm.FormClose(Sender: TObject; - var Action: TCloseAction); -var Reg : TRegistry; -begin - if DoExit or (not Options.MinimizeOnClose) then - begin - Action := caFree; - Tree.Items.Clear; - FMTree.Clear; - Reg := nil; - try - try - Reg := TRegistry.Create; - Reg.OpenKey('Software\EldoS\Keeper', true); - Reg.WriteString('OpenDir', OpenDialog.InitialDir); - Reg.WriteString('SaveDir', SaveDialog.InitialDir); - Reg.CloseKey; - finally - Reg.Free; - end; - except - on E : Exception do ; - end; - Application.Terminate; - end - else - begin - Application.Minimize; - end; -end; - -procedure TLogoAppForm.ContentsItemClick(Sender: TObject); -begin - Application.HelpCommand(HELP_FINDER, 0); -end; - -function TLogoAppForm.AppEventsHelp(Command: Word; Data: Integer; - var CallHelp: Boolean): Boolean; -begin - if (Command = HELP_CONTEXT) and (Data = 0) then - begin - CallHelp := false; - Application.HelpCommand(HELP_FINDER, 0); - end; - result := true; -end; - -procedure TLogoAppForm.GoItemClick(Sender: TObject); -begin - if (SelItem = nil) or (SelItem.Data = nil) then exit; - if PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Group then exit; - ShellExecute(0,'open',PChar(PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Location),nil, nil, SW_SHOWNORMAL); -end; - -procedure TLogoAppForm.FormDestroy(Sender: TObject); -var i : integer; - S : String; -begin - if (hMapping <> 0) then - CloseHandle(hMapping); - if Options.SaveKeys then - begin - for i := 0 to ElMRU.Sections.Count -1 do - ElMRU.Sections[i].Clear; - - Options.LastFile := ''; - end; - ElMRU.Save; - Tree.Save; - S := Tree.HeaderSections.SectionsOrder; - ElIniFile.WriteString('\LogoAppForm\Tree\ElHeader', 'Order', S); - Options.Save; - ElIniFile.Save; - FMTree.Free; - LogoAppForm := nil; -end; - -function TLogoAppForm.GetDataIndex(Data : Pointer) : integer; -var i : integer; -begin - result := -1; - for i := 0 to Tree.Items.Count - 1 do - begin - if TElMTreeItem(Tree.Items[i].Data).Data = Data then - begin - result := i; - exit; - end; - end; -end; - -procedure TLogoAppForm.CopyBtnClick(Sender: TObject); -var C : TClipboard; - Entry : PEntryRec; - S : TStringList; -begin - if Tree.ItemFocused = nil then exit; - Entry := PEntryRec(TElMTreeItem(Tree.ItemFocused.Data)^.Data); - C := TClipboard.Create; - S := TStringList.Create; - if Entry.Group - then S.Add('Group name: '+ Entry.Site) - else S.Add('Site/Program name: '+ Entry.Site); - if not Entry.Group then - begin - if Entry.Location <> '' then S.Add('Location/address: ' + Entry.Location); - if Entry.UName <> '' then S.Add('User name: ' + Entry.UName); - if Entry.Acct <> '' then S.Add('Account #: '+ Entry.Acct); - if Entry.Pswd <> '' then S.Add('Password: '+ Entry.Pswd); - if Entry.Info <> '' then S.Add('Additional info: '+ Entry.Info); - end; - C.AsText := S.Text; - S.Free; - C.Free; -end; - -procedure TLogoAppForm.PrintSetupItemClick(Sender: TObject); -begin - try - PrintSetDlg.Execute; - except - ElMessageDlg('There was an error while setting Printer properties', mtError, [mbOk], 0); - end; -end; - -procedure TLogoAppForm.PrintItemClick(Sender: TObject); -var - PrintText: TextFile; { declare a text-file variable } - i: integer; - L: TStringList; - - procedure IntPrepare(Item:TElTreeItem; Index: integer; var ContinueIterate:boolean; - IterateData:pointer; Tree:TCustomElTree); - var Entry : PEntryRec; - L, L1 : TStringList; - gap : string; - i : integer; - begin - Entry := PEntryRec(TElMTreeItem(Item.Data)^.Data); - L := TStringList(IterateData); - SetLength(gap, Item.Level*10); - FillChar(gap[1], Length(gap), 32); - if Entry.Group - then L.Add(gap + 'Group name: '+ Entry.Site) - else L.Add(gap + 'Site/Program name: '+ Entry.Site); - if not Entry.Group then - begin - if Entry.Location <> '' then L.Add(gap + 'Location/address: ' + Entry.Location); - if Entry.UName <> '' then L.Add(gap + 'User name: ' + Entry.UName); - if Entry.Acct <> '' then L.Add(gap + 'Account #: '+ Entry.Acct); - if Entry.Pswd <> '' then L.Add(gap + 'Password: '+ Entry.Pswd); - if pos(#13, Entry.Info)>0 then - begin - L1 := TStringList.Create; - try - L1.Text:=Entry.Info; - L.Add(gap + 'Additional info: '+ L1[0]); - for i := 1 to L1.Count -1 do - begin - L.Add(Gap + ' '+ L1[i]); - end; - finally - L1.Free; - end; - end else - begin - if Entry.Info <> '' then - L.Add(gap + 'Additional info: '+ Entry.Info); - end; - end; - L.Add(''); - end; - -begin - L := nil; - try - L := TStringList.Create; - L.Add(''); - L.Add(''); - L.Add(''); - L.Add('Password list from ' + FileName); - L.Add(''); - L.Add(''); - Screen.Cursor := crHourGlass; - try - AssignPrn(PrintText); { associate text file to printer device } - Rewrite(PrintText); { create and open output file } - Tree.Items.Iterate(false, true, @IntPrepare, L); - for i := 0 to L.Count -1 do - Writeln(PrintText, StrToOEM(L[i])); { write each line to printer } - finally - Screen.Cursor := crDefault; - end; // try/finally - finally - L.Free; - CloseFile(PrintText); - end; -end; - -procedure TLogoAppForm.TrayDblClick(Sender: TObject); -begin - if AMinimized then - begin - Tray.Enabled := false; - Application.Restore - end - else - begin - Tray.Enabled := false; - ShowWindow(Handle, SW_SHOW); - Windows.SetFocus(Handle); - BringToFront; - Application.BringToFront; - end; -end; - -procedure TLogoAppForm.AppEventsMinimize(Sender: TObject); -begin - MVis := IsWindowVisible(Handle) and (WindowState <> wsMinimized); - if MVis then - begin - ShowWindow(Handle,SW_HIDE); - end; - QVis := QuickAccessForm.Visible; - if QVis then - begin - QuickAccessForm.Visible := false; - //ShowWindow(QuickAccessForm.Handle, SW_HIDE); - end; - if Options.ToTray then - begin - Tray.Enabled := true; - ShowWindow(Application.Handle,SW_HIDE); - end; - AMinimized := true; -end; - -procedure TLogoAppForm.AppEventsRestore(Sender: TObject); -begin - if Options.ToTray then - begin - if MVis then - Tray.Enabled := false; - ShowWindow(Application.Handle, SW_RESTORE); - end; - if MVis then - ShowWindow(Handle, SW_SHOW); - if QVis then - begin - ShowWindow(QuickAccessForm.Handle,SW_SHOW); - QuickAccessForm.Visible := true; - end; - if QVis then - QuickAccessForm.BringToFront; - if MVis then - BringToFront; - Application.BringToFront; - AMinimized := false; -end; - -procedure TLogoAppForm.FormShow(Sender: TObject); -var bSucc : Boolean; -begin - RestoreFontSettings; - if Options.ShowPassword then - begin - Options.ShowPassword := false; - Options.ShowPassword := true; - end; - if Options.ReopenFile and (Options.LastFile <> '') and (not Options.SaveKeys) then - begin - if LoadFile(Options.LastFile, '', false) then - begin - FileName := Options.LastFile; - Opened := true; - Modified := false; - Modified2 := false; - end; - end; - if (ParamCount > 0) then - begin - if ParamCount > 1 then - bSucc := LoadFile(ParamStr(1), ParamStr(2), true) - else - bSucc := LoadFile(ParamStr(1), '', False); - if bSucc then - begin - FileName := ParamStr(1); - Modified := false; - Modified2 := false; - Opened := true; - end; - end; -end; - -procedure TLogoAppForm.PasswItemClick(Sender: TObject); -begin - Options.ShowPassword := not Options.ShowPassword; - PasswItem.Checked := not PasswItem.Checked; -end; - -procedure TLogoAppForm.ElMRUClick(Sender: TObject; Entry: TElMRUEntry); -begin - if Opened then - if not FileClose then - exit; - if LoadFile(Entry.Name, '', false) then - begin - FileName := Entry.Name; - Modified := false; - Modified2 := false; - Opened := true; - end; -end; - -procedure TLogoAppForm.FormCaptionButtonClick(Sender: TObject; - Button: TElCaptionButton); -begin - ElFormPersist.TopMost := Button.Down; -end; - -procedure TLogoAppForm.CopyPswItemClick(Sender: TObject); -var C : TClipboard; - Entry : PEntryRec; -begin - if Tree.ItemFocused = nil then exit; - Entry := PEntryRec(TElMTreeItem(Tree.ItemFocused.Data)^.Data); - if Entry.Group then exit; - C := TClipboard.Create; - C.Open; - C.AsText := Entry.Pswd; - C.Close; - C.Free; -end; - -procedure TLogoAppForm.ElFormPersistRestore(Sender: TObject); -begin - FormCaption.Buttons[0].Down := ElFormPersist.TopMost; -end; - -procedure TLogoAppForm.SetPswItemClick(Sender: TObject); -var Passw : string; - b : boolean; -begin - PasswordDlg.Password.Text:=''; - PasswordDlg.ConfPassword.visible:=true; - PasswordDlg.ConfLabel.Visible:=true; - PasswordDlg.ConfPassword.Text:=''; - repeat - if PasswordDlg.ShowModal = mrCancel then exit; - if PasswordDlg.Password.Text<>PasswordDlg.ConfPassword.Text then - ElMessageDlg (LoadStr(sPswNotMatch), mtError, [mbOk], 0) - else - if PasswordDlg.Password.Text='' then - ElMessageDlg (LoadStr(sPswEmpty), mtError, [mbOk], 0) - else break; - until false; - Passw := PasswordDlg.Password.Text; - PasswordDlg.Password.Text := ''; - PasswordDlg.ConfPassword.Text := ''; - FilePassword := Passw; - b := Options.KeepPassword; - Options.KeepPassword := true; - if FileName <> LoadStr(sUntitled) then - SaveFile(FileName); - Options.KeepPassword := b; -end; - -procedure TLogoAppForm.Go2BtnClick(Sender: TObject); -begin - if (SelItem = nil) or (SelItem.Data = nil) then exit; - if PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Group then exit; - ShellExecute(0,'open',PChar(PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.Location2),nil, nil, SW_SHOWNORMAL); -end; - -procedure TLogoAppForm.miCopyUsernameClick(Sender: TObject); -var C : TClipboard; - Entry : PEntryRec; -begin - if Tree.ItemFocused = nil then exit; - Entry := PEntryRec(TElMTreeItem(Tree.ItemFocused.Data)^.Data); - if Entry.Group then exit; - C := TClipboard.Create; - C.Open; - C.AsText := Entry.UName; - C.Close; - C.Free; -end; - -procedure TLogoAppForm.miCopyAccountClick(Sender: TObject); -var C : TClipboard; - Entry : PEntryRec; -begin - if Tree.ItemFocused = nil then exit; - Entry := PEntryRec(TElMTreeItem(Tree.ItemFocused.Data)^.Data); - if Entry.Group then exit; - C := TClipboard.Create; - C.Open; - C.AsText := Entry.Acct; - C.Close; - C.Free; -end; - -procedure TLogoAppForm.SuggestItemClick(Sender: TObject); -var SHI : TShellExecuteInfo; - saveCursor : TCursor; -begin - saveCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - try - FillMemory(@SHI, sizeof(shi), 0); - SHI.cbSize := sizeof(SHI); - SHI.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOCLOSEPROCESS; - SHI.Wnd := Application.Handle; - SHI.lpVerb := 'open'; - SHI.lpFile := PCHAR('mailto:info@eldos.org?subject=EldoS Keeper suggestion'); - SHI.lpParameters := nil; - SHI.lpDirectory := nil; - ShellExecuteEx(@SHI); - CloseHandle(SHI.hProcess); - finally - Screen.Cursor := saveCursor; - end; { try/finally } -end; - -procedure TLogoAppForm.Timer1Timer(Sender: TObject); - - procedure IterateProc(Item : TElMTreeItem; Index : integer; var ContinueIterate : boolean; - IterateData : pointer); - var Rec : PEntryRec; - begin - Rec := Item.Data; - if Rec <> nil then - begin - if not (Rec.ExpWarned) and Rec.DoExpires and ((Rec.Expires - Rec.WarnDays) < Now) then - begin - Rec.ExpWarned := true; - ElMessageDlg(Format('%s account information expires in %d days', [Rec.Site, Trunc(Rec.Expires) - Trunc(Now)]), mtWarning, [mbOk], 0); - end; - end; - end; - -begin - FMTree.Iterate(@IterateProc, nil); -end; - -procedure TLogoAppForm.TellafriendItemClick(Sender: TObject); -var SHI : TShellExecuteInfo; - saveCursor : TCursor; -begin - saveCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - try - FillMemory(@SHI, sizeof(shi), 0); - SHI.cbSize := sizeof(SHI); - SHI.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOCLOSEPROCESS; - SHI.Wnd := Application.Handle; - SHI.lpVerb := 'open'; - SHI.lpFile := PCHAR('mailto:?subject=Take%20a%20look%20at%20EldoS%20Keeper%20at%20http://www.eldos.org/elkeeper/elkeeper.html'); - SHI.lpParameters := nil; - SHI.lpDirectory := nil; - ShellExecuteEx(@SHI); - CloseHandle(SHI.hProcess); - finally - Screen.Cursor := saveCursor; - end; { try/finally } -end; - -procedure TLogoAppForm.RegisterItemClick(Sender: TObject); -var SHI : TShellExecuteInfo; - saveCursor : TCursor; -begin - saveCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - try - FillMemory(@SHI, sizeof(shi), 0); - SHI.cbSize := sizeof(SHI); - SHI.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOCLOSEPROCESS; - SHI.Wnd := Application.Handle; - SHI.lpVerb := 'open'; - SHI.lpFile := PCHAR('http://www.shareit.com/programs/101908.htm'); - SHI.lpParameters := nil; - SHI.lpDirectory := nil; - ShellExecuteEx(@SHI); - CloseHandle(SHI.hProcess); - finally - Screen.Cursor := saveCursor; - end; { try/finally } -end; - -procedure TLogoAppForm.HomepageItemClick(Sender: TObject); -var SHI : TShellExecuteInfo; - saveCursor : TCursor; -begin - saveCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - try - FillMemory(@SHI, sizeof(shi), 0); - SHI.cbSize := sizeof(SHI); - SHI.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOCLOSEPROCESS; - SHI.Wnd := Application.Handle; - SHI.lpVerb := 'open'; - SHI.lpFile := PCHAR('http://www.eldos.org/elkeeper/elkeeper.html'); - SHI.lpParameters := nil; - SHI.lpDirectory := nil; - ShellExecuteEx(@SHI); - CloseHandle(SHI.hProcess); - finally - Screen.Cursor := saveCursor; - end; { try/finally } -end; - -procedure TLogoAppForm.TreeItemPicDraw(Sender: TObject; - Item: TElTreeItem; var ImageIndex: Integer); -var Entry : PEntryRec; -begin - Entry := PEntryRec(TelMTreeItem(Item.Data).Data); - if Entry = nil then exit; - if Entry^.Group then - begin - if Item.Expanded then - ImageIndex := 1 - else - ImageIndex := 0; - end - else - ImageIndex := 2; -end; - -procedure TLogoAppForm.QuickAccessBtnClick(Sender: TObject); -begin - if not QuickAccessForm.Visible then - QuickAccessForm.Show; - QuickAccessForm.BringToFront; -end; - -procedure TLogoAppForm.WMSysCommand(var Message: TMessage); -begin - if Message.wParam = SC_MINIMIZE then - begin - if QuickAccessForm.Visible then - begin - Tray.Enabled := true; - ShowWindow(Handle, SW_HIDE); - Application.BringToFront; - QuickAccessForm.BringToFront; - end - else - Application.Minimize; - end else - {if wParam = SC_RESTORE then - begin - Tray.Enabled := false; - ShowWindow(Handle,SW_SHOW); - end;} - inherited; -end; - -procedure TLogoAppForm.TreeItemExpand(Sender: TObject; Item: TElTreeItem); -var Entry : PEntryRec; -begin - Entry := PEntryRec(TelMTreeItem(Item.Data).Data); - Entry.Expanded := true; - if Options.CountFolderChanges then - Modified := true - else - Modified2 := true; -end; - -procedure TLogoAppForm.TreeItemCollapse(Sender: TObject; - Item: TElTreeItem); -var Entry : PEntryRec; -begin - Entry := PEntryRec(TelMTreeItem(Item.Data).Data); - Entry.Expanded := false; - if Options.CountFolderChanges then - Modified := true - else - Modified2 := true; -end; - -procedure TLogoAppForm.Exit1Click(Sender: TObject); -begin - DoExit := true; - Close; -end; - -procedure TLogoAppForm.miShowQuickAccessClick(Sender: TObject); -begin - if AMinimized then - begin - MVis := false; - if not QuickAccessForm.Visible then - QuickAccessForm.Show - else - QVis := true; - Application.Restore; - ShowWindow(Handle, SW_HIDE); - end - else - begin - QuickAccessForm.Show; - ShowWindow(QuickAccessForm.Handle, SW_SHOW); - Windows.SetFocus(QuickAccessForm.Handle); - Application.BringToFront; - QuickAccessForm.BringToFront; - end; -end; - -procedure TLogoAppForm.SetFileName(const Value: string); -var View : Pointer; -begin - FFileName := Value; - if hMapping <> 0 then - begin - View := MapViewOfFile(hMapping, FILE_MAP_WRITE, 0, 0, MAX_PATH + 1); - if (View <> nil) then - begin - StrPCopy(PChar(View), Value); - UnmapViewOfFile(View); - end; - end; - FormCaption.Texts[3].Caption := FFileName; -end; - -procedure TLogoAppForm.miCheckCompatClick(Sender: TObject); -begin - ElMessageDlg('This function is not implemented yet', mtInformation, [mbOk], 0); -end; - -procedure TLogoAppForm.SetOpened(Value: Boolean); -begin - if FOpened <> Value then - begin - FOpened := Value; - if Opened then - begin - // Tree.BkColor := clWindow; - Tree.ShowColumns := true; - Tree.Enabled := true; - end - else - begin - //Tree.BkColor := clBtnFace; - Tree.ShowColumns := false; - Tree.Enabled := false; - end; - FormCaption.Texts[2].Visible := FOpened; - FormCaption.Texts[3].Visible := FOpened; - PrintItem.Enabled := FOpened; - PrintBtn.Enabled := FOpened; - end; -end; - -procedure TLogoAppForm.AppEventsIdle(Sender : TObject; var Done: Boolean); -begin - if JustStarted then - begin - JustStarted := false; - if not Opened then - FileNew(Self); - end; -end; - -procedure TLogoAppForm.TreeHeaderColumnDraw(Sender: TCustomElHeader; - Canvas : TCanvas; Section: TElHeaderSection; R: TRect; Pressed: Boolean); -var R1 : TRect; -begin - if Section.Index = hsiAttachment then - begin - CenterRects(8, R.Right - R.Left, 15, R.Bottom - R.Top, R1); - Inc(R1.Left, R.Left); - Inc(R1.Top, R.Top); - ElImgList1.Draw(Canvas, R1.Left, R1.Top, 0); - end; -end; - -procedure TLogoAppForm.TreeItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); -var Entry : PEntryRec; - R1 : TRect; -begin - if SectionIndex = hsiAttachment then - begin - Entry := PEntryRec(TelMTreeItem(Item.Data).Data); - if (not Entry.Group) and (Entry.BinDataSize > 0) then - begin - CenterRects(8, R.Right - R.Left, 15, R.Bottom - R.Top, R1); - Inc(R1.Left, R.Left); - Inc(R1.Top, R.Top); - if Item.Selected then - ElImgList1.Draw(Surface, R1.Left, R1.Top, 1) - else - ElImgList1.Draw(Surface, R1.Left, R1.Top, 0); - end; - end; -end; - -procedure TLogoAppForm.miSaveAttachClick(Sender: TObject); -var DataStream : TStream; - fns : integer; - Entry : PEntryRec; -begin - if (SelItem <> nil) and - (TElMTreeItem(SelItem.Data)^.Data <> nil) and - (PEntryRec(TElMTreeItem(SelItem.Data)^.Data)^.BinDataSize > 0) then - begin - Entry := PEntryRec(TElMTreeItem(SelItem.Data)^.Data); - AttachSaveDlg.FileName := StrPas(PChar(Entry.BinData)); - if AttachSaveDlg.Execute then - begin - DataStream := TFileStream.Create(AttachSaveDlg.FileName, fmCreate or fmShareExclusive); - try - fns := StrLen(PChar(Entry.BinData)) + 1; - DataStream.WriteBuffer((PChar(Entry.BinData) + fns)^, Entry.BinDataSize - fns); - finally - DataStream.Free; - end; - end; - end; -end; - -procedure TLogoAppForm.miExportClick(Sender: TObject); -var OutStream : TStream; - AList : TStrings; - - procedure SaveItem(Item:TElTreeItem; Index: integer; var ContinueIterate:boolean; - IterateData:pointer; Tree:TCustomElTree); - var Entry : PEntryRec; - L, L1 : TStringList; - gap : string; - i : integer; - begin - L := TStringList(IterateData); - Entry := PEntryRec(TElMTreeItem(Item.Data).Data); - SetLength(gap, Item.Level*10); - FillChar(gap[1], Length(gap), 32); - if Entry.Group - then L.Add(gap + 'Group name: '+ Entry.Site) - else L.Add(gap + 'Site/Program name: '+ Entry.Site); - if not Entry.Group then - begin - if Entry.Location <> '' then L.Add(gap + 'Location/address: ' + Entry.Location); - if Entry.UName <> '' then L.Add(gap + 'User name: ' + Entry.UName); - if Entry.Acct <> '' then L.Add(gap + 'Account #: '+ Entry.Acct); - if Entry.Pswd <> '' then L.Add(gap + 'Password: '+ Entry.Pswd); - if pos(#13, Entry.Info)>0 then - begin - L1 := TStringList.Create; - try - L1.Text:=Entry.Info; - L.Add(gap + 'Additional info: '+ L1[0]); - for i := 1 to L1.Count -1 do - begin - L.Add(Gap + ' '+ L1[i]); - end; - finally - L1.Free; - end; - end else - begin - if Entry.Info <> '' then - L.Add(gap + 'Additional info: '+ Entry.Info); - end; - end; - L.Add(''); - end; - -begin - if ExportDialog.Execute then - begin - if ExportDialog.FilterIndex = 1 then - begin - try - OutStream := TFileStream.Create(ExportDialog.FileName, fmCreate or fmShareDenyWrite); - try - AList := TStringList.Create; - try - Tree.Items.Iterate(false, true, @SaveItem, AList); - WriteTextToStream(OutStream, AList.Text); - finally - AList.Free; - end; - finally - OutStream.Free; - end; - except - on E : EInOutError do - begin - ElMessageDlg(Format('There was an error %d while writing %s', [E.ErrorCode, ExtractFileName(FFileName)]), mtError, [mbOk], 0); - end; - on E : EStreamError do - begin - ElMessageDlg(Format('There was an error while writing %s: %s', [ExtractFileName(FFileName), E.Message]), mtError, [mbOk], 0); - end; - on E : Exception do - Application.ShowException(E); - end; - - end; - end; -end; - -procedure TLogoAppForm.TreeSortEnd(Sender: TObject); -begin - if QuickAccessForm <> nil then - QuickAccessForm.UpdateTree(FMTree); -end; - -procedure TLogoAppForm.FormKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - if (Key = VK_ESCAPE) and (Shift = []) and Options.MinimizeOnEsc then - Application.Minimize; -end; - -procedure TLogoAppForm.OptionsItemClick(Sender: TObject); -begin - with TOptionsForm.Create(Self) do - begin - SetData; - if ShowModal = mrOk then - GetData; - Free; - end; -end; - -procedure TLogoAppForm.TreeHeaderLookup(Sender: TObject; - Section: TElHeaderSection; var Text: String); - -type - TSRec = record - Text: PChar; - ColNum: integer; - end; - PSRec = ^TSRec; - -var - SRec: TSrec; - TI: TElTreeItem; - - function IntCompare(Item: TElTreeItem; SearchDetails: Pointer): boolean; - var - i: integer; - AT: string; - begin - i := PSRec(SearchDetails).ColNum; - if LogoAppForm.Tree.MainTreeColumn = i then AT := AnsiUpperCase(Item.Text) else - begin - if Item.ColumnText.Count <= i then - AT := '' - else - begin - if I > LogoAppForm.Tree.MainTreeColumn then - AT := AnsiUpperCase(Item.ColumnText[i - 1]) - else - AT := AnsiUpperCase(Item.ColumnText[i]); - end; - end; - result := Pos(AnsiUpperCase(StrPas(PSRec(SearchDetails).Text)), AT) = 1; - end; - -begin - SRec.Text := PChar(Text); - SRec.ColNum := Section.Index; - TI := Tree.Items.LookForItemEx(Tree.ItemFocused, Section.Index, true, false, false, @SRec, @IntCompare); - if TI <> nil then - begin - Tree.EnsureVisible(TI); - TI.FullyExpanded := true; - Tree.ItemFocused := TI; - end; -end; - -procedure TLogoAppForm.ColumnsItemClick(Sender: TObject); -begin - Tree.HeaderSections.Owner.Setup; -end; - -procedure TLogoAppForm.SetModified2(Value: Boolean); -begin - if FModified2 <> Value then - begin - FModified2 := Value; - SaveBtn.Enabled := Modified or Value; - FileSaveItem.Enabled := Modified or Value; - end; -end; - - -procedure TLogoAppForm.TreeScroll(Sender: TObject; - ScrollBarKind: TScrollBarKind; ScrollCode: Integer); -begin - if ScrollBarKind = sbVertical then - QuickAccessForm.Tree.TopIndex := Tree.TopIndex; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/LogoStrs.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/LogoStrs.pas deleted file mode 100644 index 8e7373b280c..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/LogoStrs.pas +++ /dev/null @@ -1,20 +0,0 @@ -unit LogoStrs; - -interface - -const - { string contants in strings.rc } - sUntitled = 1; - sOverwrite = 2; - sSaveOnCLose = 3; - sFolderName = 4; - sDemoWarn = 5; - sFailSave = 6; - sFailLoad = 7; - sConfDelete = 8; - sPswNotMatch = 9; - sPswEmpty = 10; - -implementation - -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/OLEDROP.PAS b/sdk/components/ElPack/BCBDemos/ElKeeper/OLEDROP.PAS deleted file mode 100644 index d153037bd1b..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/OLEDROP.PAS +++ /dev/null @@ -1,291 +0,0 @@ -unit OLEDrop; -interface -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, activex; - -type - TOleDragObject = class(TDragObject) - private - dataObj : IDataObject; - Fkeys : longint; - FDown : boolean; - FString : string; - FList : TStringlist; - function GetFileList:TStringList; - function GetString:string; - public - constructor create; - destructor destroy; override; - function DragContent : integer; - property Keys : longint read Fkeys; - property FileList : TStringList read GetFileList; - property StringData : string read GetString; - end; - -type - IWCDropTarget = class(TInterfacedObject, IDropTarget) - private - FOwner : TWinControl; - Fhandle : HWND; - FdragObj : ToleDragObject; - FTarget : Pointer; - public - { IDropTarget } - function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; - pt: TPoint; var dwEffect: Longint): HResult; stdcall; - function DragOver(grfKeyState: Longint; pt: TPoint; - var dwEffect: Longint): HResult; stdcall; - function DragLeave: HResult; stdcall; - function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; - var dwEffect: Longint): HResult; stdcall; - constructor create(aOwner:TWinControl); - destructor destroy; override; - end; - -implementation - -Type - PDropFiles = ^TDropFiles; - TDropFiles = record - pfiles : DWORD; - pt : TPOINT; - fNC : BOOL; - fWide : BOOL; - end; - -{------------------------------------------------------------------------------} -// Copy of the control unit DragMessage function - -function DragMessage(Handle: HWND; Msg: TDragMessage; Source: TDragObject; Target: Pointer; const Pos: TPoint): Longint; -var DragRec: TDragRec; -begin - Result := 0; - if Handle <> 0 then - begin - DragRec.Pos := Pos; - DragRec.Target := Target; - DragRec.Source := Source; - Result := SendMessage(Handle, CM_DRAG, Longint(Msg), Longint(@DragRec)); - end; -end; - -{------------------------------------------------------------------------------} -constructor TOleDragObject.create; -begin - Inherited create; - FList := TStringList.Create; -end; - -destructor TOleDragObject.destroy; -begin - FList.Free; - Inherited destroy; -end; - -function TOleDragObject.DragContent : integer; -var fmt : TFormatEtc; - efe : iEnumFormatEtc; - fmtCount: LongInt; - -begin - if (FDown) or (Not assigned(dataobj)) then - begin - result:=-1; - exit; - end; - fillchar(fmt,sizeof(fmt),0); - DataObj.EnumFormatEtc(datadir_get,efe); - EFE.Reset; - repeat - fmtCount:=0; - efe.Next(1,fmt,@fmtCount); - until (fmt.cfFormat=CF_HDROP) or (fmtCount=0); - if (fmt.cfFormat=CF_HDROP) then - begin - result:=fmt.cfFormat; - exit; - end; - EFE.Reset; - repeat - fmtCount:=0; - efe.Next(1,fmt,@fmtCount); - until (fmt.cfFormat=CF_TEXT) or (fmtCount=0); - if (fmt.cfFormat=CF_TEXT) then - begin - result:=fmt.cfFormat; - exit; - end; - result:=-1; -end; - -function TOleDragObject.GetString; - var mdm: TStgMedium; - pz : pchar; - fmt : TFormatEtc; - efe : iEnumFormatEtc; - fmtCount: LongInt; - -begin - Result := FString; - if (FDown) or (Not assigned(dataobj)) then exit; - result:=''; - fillchar(fmt,sizeof(fmt),0); - DataObj.EnumFormatEtc(datadir_get,efe); - EFE.Reset; - repeat - fmtCount:=0; - efe.Next(1,fmt,@fmtCount); - until (fmt.cfFormat=CF_TEXT) or (fmtCount=0); - if fmt.cfFormat<>CF_TEXT then - begin - result:=''; - exit; - end; - fmt.tymed := TYMED_HGLOBAL; - fmt.lindex := -1; - if dataobj.GetData(fmt,mdm)<>S_OK then result:='' else - try - if (fmt.cfFormat=CF_TEXT) and (mdm.tymed = TYMED_HGLOBAL) then - begin - pz := GlobalLock(mdm.HGlobal); - FString:=StrPas(pz); - Result:=FString; - GlobalUnlock(mdm.HGlobal); - end; - finally - if Assigned(mdm.unkForRelease) then - Iunknown(mdm.unkForRelease)._Release; - FDown := TRUE; - end; -end; - -function TOleDragObject.GetFileList; -var mdm:TStgMedium; - pz : pchar; - pdf : PDropFiles; - fmt : TFormatEtc; - s : string; - -begin - Result := FList; - if (FDown) or (Not assigned(DataObj)) then exit; - FList.Clear; - FillChar(fmt,sizeof(fmt),0); - fmt.cfFormat := CF_HDROP; - fmt.tymed := TYMED_HGLOBAL; - fmt.lindex := -1; - if dataobj.GetData(fmt,mdm)<>S_OK then - raise Exception.Create('IDataObject.GetData failed'); - try - if mdm.tymed = TYMED_HGLOBAL then - begin - pdf := GlobalLock(mdm.HGlobal); - pz := pchar(pdf); - Inc(pz, pdf^.pFiles); - if not (pdf.fWide) then - while (pz[0]<>#0) do - begin - FList.Add(string(pz)); - Inc(pz,1+strlen(pz)); - end - else - while (pz[0]<>#0) do - begin - s:=WideCharToString(PWideChar(pz)); - FList.Add(s); - Inc(pz,length(s)*2+2); - end; - GlobalUnlock(mdm.HGlobal); - end; - finally - if Assigned(mdm.unkForRelease) then - IUnknown(mdm.unkForRelease)._Release; - FDown := TRUE; - end; -end; - -{------------------------------------------------------------------------------} - -constructor IWCDropTarget.create(aOwner:TWinControl); -var rslt:HResult; obj:IDropTarget; -begin - Inherited create; - oleInitialize(nil); - FOwner := AOwner; - FHandle := aOwner.Handle; - _AddRef; - if not GetInterface(Iunknown,obj) then - raise Exception.Create('GetInterface failed'); - - Rslt := RegisterDragDrop(FHandle,obj as IDroptarget); - case Rslt of - S_OK : ; - DRAGDROP_E_INVALIDHWND : raise Exception.Create('RegisterDragDrop failed, invalide hwnd '); - DRAGDROP_E_ALREADYREGISTERED : raise Exception.Create('RegisterDragDrop failed, already registered'); - E_OUTOFMEMORY : raise Exception.Create('RegisterDragDrop failed, out of memory'); - E_INVALIDARG : raise Exception.Create('RegisterDragDrop failed, invalid arg'); - CO_E_NOTINITIALIZED : raise Exception.Create('RegisterDragDrop failed, coInitialize had not been called'); - else raise Exception.Create('RegisterDragDrop failed, unknown error code '+IntToStr(rslt and $7FFFFFFF)); - end; -end; - -destructor IWCDropTarget.destroy; -begin - RevokeDragDrop(FHandle); - oleUnInitialize; - Inherited destroy; -end; - -function IWCDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; -begin - // TDragState = (dsDragEnter, dsDragLeave, dsDragMove); - // TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop, dmDragCancel,dmFindTarget); - - FDragobj := ToleDragObject.Create; Fdragobj.dataObj := dataObj; Fdragobj.Fkeys := grfKeyState; - FTarget := pointer(DragMessage(FHandle,dmFindTarget,FDragObj,NIL,pt)); - - if DragMessage(FHandle,dmDragEnter,Fdragobj,FTarget,pt)<>0 - then dwEffect := DROPEFFECT_LINK - else dwEffect := DROPEFFECT_NONE; - - Result := S_OK; -end; - -function IWCDropTarget.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; -begin - Fdragobj.Fkeys := grfKeyState; - FTarget := pointer(DragMessage(FHandle,dmFindTarget,FDragObj,NIL,pt)); - if DragMessage(FHandle,dmDragMove,Fdragobj,Ftarget,pt)<>0 - then dwEffect := DROPEFFECT_LINK - else dwEffect := DROPEFFECT_NONE; - Result := S_OK; -end; - -function IWCDropTarget.DragLeave: HResult; -var pt:TPoint; -begin - DragMessage(FHandle,dmDragCancel,Fdragobj,FTarget,pt); - if Assigned(FDragObj) then - begin - Fdragobj.Free; - Fdragobj := nil; - end; - Result := S_OK; -end; - -function IWCDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; -begin - Fdragobj.Fkeys := grfKeyState; - if DragMessage(FHandle,dmDragDrop,Fdragobj,FTarget,pt)<>0 - then dwEffect := DROPEFFECT_LINK - else dwEffect := DROPEFFECT_NONE; - if Assigned(FDragObj) then - begin - Fdragobj.Free; - Fdragobj := nil; - end; - Result := S_OK; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/PswRec.res b/sdk/components/ElPack/BCBDemos/ElKeeper/PswRec.res deleted file mode 100644 index 6dffa82c3c9..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/PswRec.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmFolderProp.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/frmFolderProp.dfm deleted file mode 100644 index 5bee280db14..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/frmFolderProp.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmFolderProp.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/frmFolderProp.pas deleted file mode 100644 index 10cb6cae727..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/frmFolderProp.pas +++ /dev/null @@ -1,31 +0,0 @@ -unit frmFolderProp; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElBtnCtl, ElPopBtn, ElACtrls, ElFrmPers, ElXPThemedControl, - ExtCtrls, ElPanel; - -type - TFolderPropsForm = class(TForm) - FormPers: TElFormPersist; - ElPanel1: TElPanel; - Label1: TLabel; - SiteNameEdit: TElAdvancedEdit; - CancelBtn: TElPopupButton; - OKBtn: TElPopupButton; - private - { Private declarations } - public - { Public declarations } - end; - -var - FolderPropsForm: TFolderPropsForm; - -implementation - -{$R *.DFM} - -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPassword.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/frmPassword.dfm deleted file mode 100644 index fb0f450035c..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPassword.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPassword.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/frmPassword.pas deleted file mode 100644 index 0c915979b76..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPassword.pas +++ /dev/null @@ -1,40 +0,0 @@ -unit frmPassword; - -interface - -uses Windows, SysUtils, Classes, Forms, Controls, StdCtrls, - Buttons, ElACtrls, ElBtnCtl, ElPopBtn, ElFlatCtl, ElXPThemedControl, - ExtCtrls, ElPanel; - -type - TPasswordDlg = class(TForm) - ElFlatController1: TElFlatController; - ElFlatController2: TElFlatController; - ElPanel1: TElPanel; - Label1: TLabel; - ConfLabel: TLabel; - OKBtn: TElPopupButton; - CancelBtn: TElPopupButton; - Password: TEdit; - ConfPassword: TEdit; - procedure FormShow(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - PasswordDlg: TPasswordDlg; - -implementation - -{$R *.DFM} - -procedure TPasswordDlg.FormShow(Sender: TObject); -begin - ActiveControl := Password; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPswGen.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/frmPswGen.dfm deleted file mode 100644 index eaead62b46b..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPswGen.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPswGen.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/frmPswGen.pas deleted file mode 100644 index 64f45fae700..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/frmPswGen.pas +++ /dev/null @@ -1,115 +0,0 @@ -unit frmPswGen; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElIni, ElBtnCtl, ElCheckCtl, ElACtrls, ElPopBtn, - ElSpin, ElFrmPers, ElXPThemedControl, ElGroupBox, ExtCtrls, ElPanel; - -type - TPswGenForm = class(TForm) - GroupBox1: TElGroupBox; - Label1: TLabel; - Label2: TLabel; - Label3: TLabel; - FormPers: TElFormPersist; - CapRB: TElCheckBox; - LetRB: TElCheckBox; - DigRB: TElCheckBox; - AllRB: TElCheckBox; - CustomRB: TElCheckBox; - OKBtn: TElPopupButton; - CancelBtn: TElPopupButton; - PswGenBtn: TElPopupButton; - CustomEdit: TElAdvancedEdit; - PswEdit: TElAdvancedEdit; - LengthSpin: TElSpinEdit; - procedure CustomRBClick(Sender: TObject); - procedure PswGenBtnClick(Sender: TObject); - procedure OKBtnClick(Sender: TObject); - procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); - private - { Private declarations } - public - DoAccept : boolean; - Pssw : string; - end; - -var - PswGenForm: TPswGenForm; - -implementation - -uses LogoMain; - -{$R *.DFM} - -procedure TPswGenForm.CustomRBClick(Sender: TObject); -begin - CustomEdit.Enabled := CustomRB.Checked; - if CustomEdit.Enabled - then CustomEdit.Color := clWindow - else CustomEdit.ParentColor := true; -end; - -type TSymArray = array [0 .. 255] of char; - -procedure TPswGenForm.PswGenBtnClick(Sender: TObject); -var i, j : integer; - arrlen : integer; - SA : String; -begin - if CapRB.Checked then - for i := ord('A') to ord('Z') do SA := sa + char(i); - if LetRB.Checked then - for i := ord('a') to ord('z') do SA := sa + char(i); - if DigRB.Checked then - for i := ord('0') to ord('9') do SA := sa + char(i); - if AllRB.Checked then - begin - SA := sa + '!'; - SA := sa + '@'; - SA := sa + '#'; - SA := sa + '$'; - SA := sa + '%'; - SA := sa + '^'; - SA := sa + '&'; - SA := sa + '*'; - end; - if CustomRB.Checked then - begin - for i := 1 to Length(CustomEdit.Text) do - if Pos(CustomEdit.Text[i], SA) = 0 then SA := SA + CustomEdit.Text[i]; - end; - arrlen := Length(SA); - if arrlen > 0 then - begin - Randomize; - SetLength(Pssw, LengthSpin.Value); - for i := 1 to LengthSpin.Value do - begin - j := Round(Random(arrlen))+1; - Pssw[i] := SA[j]; - end; - PswEdit.Text := Pssw; - end; -end; - -procedure TPswGenForm.OKBtnClick(Sender: TObject); -begin - DoAccept := true; -end; - -procedure TPswGenForm.FormCloseQuery(Sender: TObject; - var CanClose: Boolean); -begin - if DoAccept then - begin - DoAccept := false; - CanClose := MessageDlg('Do you want to accept the generated password?', mtConfirmation, [mbOk, mbCancel], 0) = mrOk; - end; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmQuickAccess.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/frmQuickAccess.dfm deleted file mode 100644 index 7883fa3954f..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/frmQuickAccess.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmQuickAccess.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/frmQuickAccess.pas deleted file mode 100644 index e2c65541028..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/frmQuickAccess.pas +++ /dev/null @@ -1,409 +0,0 @@ -unit frmQuickAccess; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ElSplit, ExtCtrls, ElPanel, ElTree, LogoMain, ElFrmPers, StdCtrls, frmRecProp, - ElVCLUtils, ElACtrls, ElCaption, ElMTree, ComCtrls, ElDragDrop, ElImgLst, - ImgList, EntryData, ElXPThemedControl; - -type - TQuickAccessForm = class(TForm) - Tree: TElTree; - InfoPanel: TElPanel; - ElFormPersist: TElFormPersist; - Label1: TLabel; - Label2: TLabel; - Label3: TLabel; - Label4: TLabel; - UserNameSource: TElDragDrop; - ImgList: TElImageList; - AccountSource: TElDragDrop; - PasswordSource: TElDragDrop; - LocationSource: TElDragDrop; - UserNameText: TElAdvancedEdit; - AccountText: TElAdvancedEdit; - PasswordText: TElAdvancedEdit; - LocationText: TElAdvancedEdit; - FormPersist: TElFormPersist; - FormCaption: TElFormCaption; - procedure TreeItemFocused(Sender: TObject); - procedure TreeItemPicDraw(Sender: TObject; Item: TElTreeItem; - var ImageIndex: Integer); - procedure TreeDblClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure UserNameSourceOleStartDrag(Sender: TObject; - var DragData: Pointer; var DragDataType, DragDataSize: Integer); - procedure UserNameSourceOleSourceDrag(Sender: TObject; - DragType: TDragType; shift: TShiftState; var ContinueDrop: Boolean); - procedure UserNameSourceTargetDrop(Sender: TObject; - Source: TOleDragObject; Shift: TShiftState; X, Y: Integer; - var DragType: TDragType); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure FormCreate(Sender: TObject); - procedure UserNameSourcePaint(Sender: TObject); - procedure FormCaptionButtonClick(Sender: TObject; - Button: TElCaptionButton); - procedure TreeCompareItems(Sender: TObject; Item1, Item2: TElTreeItem; - var res: Integer); - private - FEnBmp : TBitmap; - FDisBmp : TBitmap; - procedure UpdateImages; - public - procedure UpdateTree(MTree : TElMTree); - end; - -var - QuickAccessForm: TQuickAccessForm; - -implementation - -{$R *.DFM} - -procedure TQuickAccessForm.UpdateImages; -begin - UsernameSource.Enabled := Length(UsernameText.Text) > 0; - AccountSource.Enabled := Length(AccountText.Text) > 0; - LocationSource.Enabled := Length(LocationText.Text) > 0; - PasswordSource.Enabled := Length(PasswordText.Text) > 0; - - UsernameSource.Invalidate; - AccountSource.Invalidate; - LocationSource.Invalidate; - PasswordSource.Invalidate; -end; - -procedure TQuickAccessForm.UpdateTree(MTree : TElMTree); - - function DataPresent(Data : Pointer; Branch : TElMTreeItem) : TElMTreeItem; - var i : integer; - begin - result := nil; - for i := 0 to Branch.List.Count - 1 do - begin - if TElMTreeItem(Branch.List[i]).Data = Data then - begin - result := TElMTreeItem(Branch.List[i]); - exit; - end; - end; - end; - - procedure ClearItems(AnItem : TElTreeItem; MTreeItem : TElMTreeItem); - var i : integer; - begin - i := 0; - while i < AnItem.Count do - begin - if (DataPresent(AnItem.Children[i].Data, MTreeItem) = nil) then - Tree.Items.DeleteItem(AnItem.Children[i]) - else - inc(i); - end; - end; - - procedure UpdateItems(AnItem : TElTreeItem; MTreeItem : TElMTreeItem); - var i, - j : integer; - P : TElMTreeItem; - T : TElTreeItem; - b : boolean; - begin - i := 0; - while i < MTreeItem.List.Count do - begin - b := false; - T := nil; - P := TElMTreeItem(MTreeItem.List[i]).Data; - for j := 0 to AnItem.Count - 1 do - begin - T := AnItem.Children[j]; - if T.Data = P then - begin - b := true; - break; - end; - end; - if not b then - begin - T := Tree.Items.AddItem(AnItem); - AnItem.Expand(false); - T.ImageIndex := -1; - T.StateImageIndex := -1; - T.Data := P; - end; - T.Text := PEntryRec(P).Site; - UpdateItems(T, MTreeItem.List[i]); - inc(i); - end; - end; - - -var P : TElMTreeItem; - T : TElTreeItem; - i, - j : integer; - b : boolean; -begin - if QuickAccessForm = nil then - exit; - Tree.Items.BeginUpdate; - try - i := 0; - while i < Tree.Items.RootCount do - begin - P := DataPresent(Tree.Items.RootItem[i].Data, MTree.Root); - if (P = nil) then - Tree.Items.DeleteItem(Tree.Items.RootItem[i]) - else - begin - ClearItems(Tree.Items.RootItem[i], P); - inc(i); - end; - end; - for i := 0 to MTree.Root.List.Count - 1 do - begin - b := false; - T := nil; - P := TElMTreeItem(MTree.Root.List[i]).Data; - for j := 0 to Tree.Items.RootCount - 1 do - begin - T := Tree.Items.RootItem[j]; - if T.Data = P then - begin - b := true; - break; - end; - end; - if not b then - begin - T := Tree.Items.AddItem(nil); - T.ImageIndex := -1; - T.StateImageIndex := -1; - T.Data := P; - end; - T.Text := PEntryRec(P).Site; - T.ColumnText.Clear; - UpdateItems(T, MTree.Root.List[i]); - end; - finally - Tree.Items.EndUpdate; - end; - Tree.Sort(true); - UpdateImages; -end; - -procedure TQuickAccessForm.TreeItemFocused(Sender: TObject); -var Entry : PEntryRec; -begin - if (QuickAccessForm = nil) or (csDestroying in ComponentState) then - exit; - if (Tree.ItemFocused = nil) or (PEntryRec(Tree.ItemFocused.Data).Group) then - begin - UserNameText.Text := ''; - AccountText.Text := ''; - PasswordText.Text := ''; - LocationText.Text := ''; - end - else - begin - Entry := PEntryRec(Tree.ItemFocused.Data); - UserNameText.Text := Entry.UName; - AccountText.Text := Entry.Acct; - PasswordText.Text := Entry.Pswd; - LocationText.Text := Entry.Location ; - end; - UpdateImages; -end; - -procedure TQuickAccessForm.TreeItemPicDraw(Sender: TObject; - Item: TElTreeItem; var ImageIndex: Integer); -begin - if PEntryRec(Item.Data).Group then - begin - if Item.Expanded then - ImageIndex := 1 - else - ImageIndex := 0; - end - else - ImageIndex := 2; -end; - -procedure TQuickAccessForm.TreeDblClick(Sender: TObject); -var Item : TElTreeItem; - P : TPoint; -begin - GetCursorPos(P); - P := Tree.ScreenToClient(P); - Item := Tree.GetItemAtY(P.Y); - if Item <> nil then - begin - //Item := LogoAppForm.Tree.Items.LookForItem(nil, ); - if Item <> nil then - LogoAppForm.Tree.EnsureVisible(Item); - end; -end; - -procedure TQuickAccessForm.FormDestroy(Sender: TObject); -begin - QuickAccessForm := nil; - FEnBmp.Free; - FDisBmp.Free; -end; - -procedure TQuickAccessForm.UserNameSourceOleStartDrag(Sender: TObject; - var DragData: Pointer; var DragDataType, DragDataSize: Integer); -var P : PChar; - S : String; - Edt : TElAdvancedEdit; -begin - DragDataType := CF_TEXT; - Edt := nil; - if Sender = UserNameSource then - begin - Edt := UserNameText; - end - else - if Sender = AccountSource then - begin - Edt := AccountText; - end - else - if Sender = PasswordSource then - begin - Edt := PasswordText; - end - else - if Sender = LocationSource then - begin - Edt := LocationText; - end; - if Edt = nil then exit; - if Edt.SelLength > 0 then - S := Copy(Edt.Text, Edt.SelStart, Edt.SelLength) - else - S := Edt.Text; - if Length(S) = 0 then - begin - DragData := nil; - exit; - end; - GetMem(P, Length(S) + 1); - StrPCopy(P, S); - DragData := P; - DragDataSize := Length(S) + 1; -end; - -procedure TQuickAccessForm.UserNameSourceOleSourceDrag(Sender: TObject; - DragType: TDragType; shift: TShiftState; var ContinueDrop: Boolean); -begin - ContinueDrop := true; -end; - -procedure TQuickAccessForm.UserNameSourceTargetDrop(Sender: TObject; - Source: TOleDragObject; Shift: TShiftState; X, Y: Integer; - var DragType: TDragType); -begin - DragType := dtCopy; -end; - -procedure TQuickAccessForm.FormClose(Sender: TObject; - var Action: TCloseAction); -begin - if (LogoAppForm <> nil) and LogoAppForm.HandleAllocated and not IsWindowVisible(LogoAppForm.Handle) then - begin - Hide; - LogoAppForm.QVis := false; - Application.Minimize; - LogoAppForm.MVis := true; - LogoAppForm.QVis := false; - end; -end; - -procedure TQuickAccessForm.FormCreate(Sender: TObject); -begin - FEnBmp := TBitmap.Create; - FDisBmp := TBitmap.Create; - FEnBmp.Width := ImgList.Width; - FEnBmp.Height := ImgList.Height; - FDisBmp.Width := ImgList.Width; - FDisBmp.Height := ImgList.Height; - - ImgList.Draw(FEnBmp.Canvas, 0, 0, 0); - ImgList.Draw(FDisBmp.Canvas, 0, 0, 1); -end; - -procedure TQuickAccessForm.UserNameSourcePaint(Sender: TObject); -var ABitmap : TBitmap; - ACanvas : TCanvas; -begin - if Sender = UserNameSource then - begin - if Length(UserNameText.Text) > 0 then - ABitmap := FEnBmp - else - ABitmap := FDisBmp; - ACanvas := UsernameSource.Canvas; - end - else - if Sender = PasswordSource then - begin - if Length(PasswordText.Text) > 0 then - ABitmap := FEnBmp - else - ABitmap := FDisBmp; - ACanvas := PasswordSource.Canvas; - end - else - if Sender = LocationSource then - begin - if Length(LocationText.Text) > 0 then - ABitmap := FEnBmp - else - ABitmap := FDisBmp; - ACanvas := LocationSource.Canvas; - end - else - if Sender = AccountSource then - begin - if Length(AccountText.Text) > 0 then - ABitmap := FEnBmp - else - ABitmap := FDisBmp; - ACanvas := AccountSource.Canvas; - end - else - exit; - - DrawTransparentBitmapEx(ACanvas.Handle, ABitmap, 0, 0, - Rect(0, 0, ABitmap.Width - 1, ABitmap.Height - 1), ABitmap.Canvas.Pixels[0, ABitmap.Height - 1]); -end; - -procedure TQuickAccessForm.FormCaptionButtonClick(Sender: TObject; - Button: TElCaptionButton); -begin - FormPersist.TopMost := Button.Down; -end; - -procedure TQuickAccessForm.TreeCompareItems(Sender: TObject; Item1, - Item2: TElTreeItem; var res: Integer); -var i1, - i2 : integer; - -begin - i1 := LogoAppForm.GetDataIndex(Item1.Data); - i2 := LogoAppForm.GetDataIndex(Item2.Data); - if i2 > i1 then - res := -1 - else - if i2 < i1 then - res := 1 - else - res := 0; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmRecProp.dfm b/sdk/components/ElPack/BCBDemos/ElKeeper/frmRecProp.dfm deleted file mode 100644 index 40e9f7bb000..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/frmRecProp.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/frmRecProp.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/frmRecProp.pas deleted file mode 100644 index d0eca47cafd..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/frmRecProp.pas +++ /dev/null @@ -1,393 +0,0 @@ -unit frmRecProp; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ExtCtrls, ShellApi, OleDrop, ActiveX, ElTools, EntryData, - Menus, ElFrmPers, ElIni, ElACtrls, ElBtnCtl, ElPopBtn, ElCheckCtl, - ElBtnEdit, - ComCtrls, ElFlatCtl, ElSpin, ElDTPick, ElPromptDlg, hexeditor, Grids, - ElPgCtl, ElXPThemedControl, ElPanel; - -type - TRecPropsForm = class(TForm) - FormPers: TElFormPersist; - AttachSaveDlg: TSaveDialog; - AttachOpenDlg: TOpenDialog; - ElFlatController1: TElFlatController; - ElPanel1: TElPanel; - ElPageControl1: TElPageControl; - Main: TElTabSheet; - Label1: TLabel; - Label2: TLabel; - Label3: TLabel; - Label4: TLabel; - Label5: TLabel; - Label7: TLabel; - Label8: TLabel; - Label9: TLabel; - GoBtn: TElPopupButton; - PswGenBtn: TElPopupButton; - Go2Btn: TElPopupButton; - SiteNameEdit: TElAdvancedEdit; - URLEdit: TElAdvancedEdit; - UNameEdit: TElAdvancedEdit; - AcctEdit: TElAdvancedEdit; - PswEdit: TElAdvancedEdit; - URL2Edit: TElAdvancedEdit; - dtpAdded: TElDateTimePicker; - dtpModified: TElDateTimePicker; - OKBtn: TElPopupButton; - CancelBtn: TElPopupButton; - ElTabSheet3: TElTabSheet; - Label12: TLabel; - AttachedLabel: TLabel; - HexView: THexEditor; - TextView: TElAdvancedMemo; - ClearDataButton: TElPopupButton; - AttachDataButton: TElPopupButton; - SaveDatabutton: TElPopupButton; - AsTextRadio: TElRadioButton; - AsHexRadio: TElRadioButton; - ElTabSheet2: TElTabSheet; - Label6: TLabel; - Label10: TLabel; - Label11: TLabel; - InfoMemo: TElAdvancedMemo; - WrapCB: TElCheckBox; - ExpiresCB: TElCheckBox; - NotifySpin: TElSpinEdit; - dtpExpires: TElDateTimePicker; - procedure URLEditChange(Sender: TObject); - procedure GoBtnClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure SiteNameEditDragDrop(Sender, Source: TObject; X, Y: Integer); - procedure SiteNameEditDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); - procedure URLEditDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); - procedure URLEditDragDrop(Sender, Source: TObject; X, Y: Integer); - procedure PswGenBtnClick(Sender: TObject); - procedure Go2BtnClick(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure WrapCBClick(Sender: TObject); - procedure ExpiresCBClick(Sender: TObject); - procedure ClearDataButtonClick(Sender: TObject); - procedure SaveDatabuttonClick(Sender: TObject); - procedure URL2EditChange(Sender: TObject); - procedure URL2EditDragDrop(Sender, Source: TObject; X, Y: Integer); - procedure URL2EditDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); - procedure AttachDataButtonClick(Sender: TObject); - procedure AsHexRadioClick(Sender: TObject); - procedure AsTextRadioClick(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - Entry : PEntryRec; - FSNDropTarget, - FLDropTarget : IDropTarget; - BinDataSize : DWORD; - BinData : Pointer; - procedure GetData; - procedure SetData; - end; - -var - RecPropsForm: TRecPropsForm; - -implementation - -uses frmPswGen, LogoMain; - -resourcestring - sNone = '(None)'; - sPresent = 'Present '; - -procedure TRecPropsForm.GetData; { public } -begin - Entry^.Site:=SiteNameEdit.Text; - Entry^.Location:=URLEdit.Text; - Entry^.UName:=UNameEdit.Text; - Entry^.Acct:=AcctEdit.Text; - Entry^.Pswd:=PswEdit.Text; - Entry^.Info:=InfoMemo.Text; - Entry^.Location2 := URL2Edit.Text; - Entry^.Modified := Now; - if Trunc(Entry^.Expires) <> Trunc(dtpExpires.Date) then Entry.ExpWarned := false; - Entry^.Expires := Trunc(dtpExpires.Date); - Entry^.DoExpires := ExpiresCB.Checked; - Entry.WarnDays := NotifySpin.Value; - if Entry.BinData <> nil then - FreeMem(Entry.BinData); - Entry.BinDataSize := 0; - if BinData <> nil then - begin - GetMem(Entry.BinData, BinDataSize); - MoveMemory(Entry.BinData, BinData, BinDataSize); - Entry.BinDataSize := BinDataSize; - end; -end; { GetData } - -procedure TRecPropsForm.SetData; { public } -var Stream : TDirectMemoryStream; -begin - SiteNameEdit.Text:=Entry^.Site; - URLEdit.Text:=Entry^.Location; - UNameEdit.Text:=Entry^.UName; - AcctEdit.Text:=Entry^.Acct; - PswEdit.Text:=Entry^.Pswd; - InfoMemo.Text:=Entry^.Info; - URL2Edit.Text:=Entry^.Location2; - dtpModified.Date := Entry^.Modified; - dtpAdded.Date := Entry.Added; - dtpExpires.Date := Entry^.Expires; - NotifySpin.Value := Entry.WarnDays; - ExpiresCB.Checked := Entry^.DoExpires; - if Entry^.BinDataSize > 0 then - begin - BinDataSize := Entry.BinDataSize; - GetMem(BinData, BinDataSize); - MoveMemory(BinData, Entry.BinData, BinDataSize); - AttachedLabel.Caption := StrPas(PChar(Entry.BinData)) + ' (' + IntToStr(BinDataSize - StrLen(PChar(Entry.BinData)) - 1) + ' bytes)'; - Stream := TDirectMemoryStream.Create; - Stream.SetPointer(BinData, BinDataSize); - Stream.Seek(StrLen(PChar(Entry.BinData)) + 1, soFromBeginning); - HexView.LoadFromStream(Stream); - Stream.SetPointer(nil, 0); - end - else - begin - BinData := nil; - BinDataSize := 0; - AttachedLabel.Caption := sNone; - HexView.AsText := ''; - end; - if AsHexRadio.Checked then - AsHexRadioClick(Self) - else - AsTextRadioClick(Self); - - ExpiresCBClick(Self); -end; { SetData } - -{$R *.DFM} - -procedure TRecPropsForm.URLEditChange(Sender: TObject); -begin - GoBtn.Enabled:=UrlEdit.Text<>''; -end; - -procedure TRecPropsForm.GoBtnClick(Sender: TObject); -begin - ShellExecute(0,'open',PChar(UrlEdit.Text),nil, nil, SW_SHOWNORMAL); -end; - -procedure TRecPropsForm.FormCreate(Sender: TObject); -begin - FSNDropTarget := IWCDroptarget.Create(SiteNameEdit); - FLDropTarget := IWCDroptarget.Create(URLEdit); -end; - -procedure TRecPropsForm.FormDestroy(Sender: TObject); -begin - FSNDropTarget := nil; - FLDropTarget := nil; -end; - -procedure TRecPropsForm.SiteNameEditDragDrop(Sender, Source: TObject; X, - Y: Integer); -var i : Integer; -begin - if Source is ToleDragObject then - begin - i:=ToleDragObject(source).DragContent; - if i=CF_Text then - SiteNameEdit.Text:= ToleDragObject(source).StringData; - end; -end; - -procedure TRecPropsForm.SiteNameEditDragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); -begin - Accept := Source is ToleDragObject; -end; - -procedure TRecPropsForm.URLEditDragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); -begin - Accept := Source is TOleDragObject; -end; - -procedure TRecPropsForm.URLEditDragDrop(Sender, Source: TObject; X, - Y: Integer); -begin - if Source is ToleDragObject then - begin - if ToleDragObject(source).DragContent = CF_Text then - URLEdit.Text:= ToleDragObject(source).StringData; - end; -end; - -procedure TRecPropsForm.PswGenBtnClick(Sender: TObject); -begin - PswGenForm := TPswGenForm.Create(nil); - if PswGenForm.ShowModal = mrOk then - begin - PswEdit.Text := PswGenForm.Pssw; - end; - PswGenForm.Free; - PswGenForm := nil; -end; - -procedure TRecPropsForm.Go2BtnClick(Sender: TObject); -begin - ShellExecute(0,'open',PChar(Url2Edit.Text),nil, nil, SW_SHOWNORMAL); -end; - -procedure TRecPropsForm.FormShow(Sender: TObject); -begin - ActiveControl := SiteNameEdit; -end; - -procedure TRecPropsForm.WrapCBClick(Sender: TObject); -begin - InfoMemo.WordWrap := WrapCB.Checked; - if WrapCB.Checked then - InfoMemo.Scrollbars := ssVertical - else - InfoMemo.Scrollbars := ssBoth; -end; - -procedure TRecPropsForm.ExpiresCBClick(Sender: TObject); -begin - dtpExpires.Enabled := ExpiresCB.Checked; - NotifySpin.Enabled := ExpiresCB.Checked; -end; - -procedure TRecPropsForm.ClearDataButtonClick(Sender: TObject); -begin - if BinDataSize > 0 then - begin - if ElMessageDlg('Do you want to clear all associated data?', mtWarning, [mbYes, mbNo], 0) = idYes then - begin - FreeMem(BinData); - BinData := nil; - BinDataSize := 0; - AttachedLabel.Caption := sNone; - HexView.CreateEmptyFile('unnamed'); - TextView.Text := ''; - end; - end; -end; - -procedure TRecPropsForm.SaveDatabuttonClick(Sender: TObject); -var DataStream : TStream; - fns : DWORD; -begin - if BinDataSize > 0 then - begin - AttachSaveDlg.FileName := StrPas(PChar(Entry.BinData)); - if AttachSaveDlg.Execute then - begin - DataStream := TFileStream.Create(AttachSaveDlg.FileName, fmCreate or fmShareExclusive); - try - fns := StrLen(PChar(Entry.BinData)) + 1; - DataStream.WriteBuffer((PChar(BinData) + fns)^, BinDataSize - fns); - finally - DataStream.Free; - end; - end; - end - else - ElMessageDlg('There is no data available for saving', mtInformation, [mbOk], 0); -end; - -procedure TRecPropsForm.URL2EditChange(Sender: TObject); -begin - Go2Btn.Enabled:=Url2Edit.Text<>''; -end; - -procedure TRecPropsForm.URL2EditDragDrop(Sender, Source: TObject; X, - Y: Integer); -begin - if Source is ToleDragObject then - begin - if ToleDragObject(source).DragContent = CF_Text then - URL2Edit.Text := ToleDragObject(source).StringData; - end; -end; - -procedure TRecPropsForm.URL2EditDragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); -begin - Accept := Source is TOleDragObject; -end; - -procedure TRecPropsForm.AttachDataButtonClick(Sender: TObject); -var NewData : Pointer; - NewSize : integer; - DataStream : TStream; - b : boolean; - FN: string; -begin - if BinDataSize > 0 then - b := ElMessageDlg('Attaching new data will clear all currently associated data. Continue?', mtWarning, [mbYes, mbNo], 0) = idYes - else - b := true; - if b then - begin - if AttachOpenDlg.Execute then - begin - DataStream := TFileStream.Create(AttachOpenDlg.FileName, fmOpenRead or fmShareDenyWrite); - try - FN := ExtractFileName(AttachOpenDlg.FileName); - NewSize := DataStream.Size + Length(FN) + 1; - GetMem(NewData, NewSize); - StrCopy(PChar(NewData), PChar(FN)); - DataStream.ReadBuffer((PChar(NewData) + Length(FN) + 1)^, DataStream.Size); - if BinData <> nil then - begin - FreeMem(BinData); - BinData := nil; - BinDataSize := 0; - end; - BinData := NewData; - BinDataSize := NewSize; - AttachedLabel.Caption := FN + ' (' + IntToStr(BinDataSize - Length(FN) - 1) + ' bytes)'; - DataStream.Position := 0; - HexView.LoadFromStream(DataStream); - if AsTextRadio.Checked then - AsTextRadioClick(Self); - - if ElMessageDlg('Add the name of the attached file and current time to record notes?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then - begin - InfoMemo.Lines.Add('Filename: ' + ExtractFileName(AttachOpenDlg.FileName)); - InfoMemo.Lines.Add('Added: ' + FormatDateTime('c', Now)); - end; - finally - DataStream.Free; - end; - end; - end; -end; - -procedure TRecPropsForm.AsHexRadioClick(Sender: TObject); -begin - HexView.Visible := true; - TextView.Visible := false; - TextView.Text := ''; -end; - -procedure TRecPropsForm.AsTextRadioClick(Sender: TObject); -begin - TextView.Text := HexView.AsText; - TextView.Visible := true; - HexView.Visible := false; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/hexeditor.dcr b/sdk/components/ElPack/BCBDemos/ElKeeper/hexeditor.dcr deleted file mode 100644 index 96c441566ff..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ElKeeper/hexeditor.dcr and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/hexeditor.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/hexeditor.pas deleted file mode 100644 index 8f3dac52529..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/hexeditor.pas +++ /dev/null @@ -1,4663 +0,0 @@ -unit hexeditor; - -{ THexEditor v1.16, - THexToCanvas v1.0 Beta 2 - - THexEditor descends from TCustomGrid, and displays and edits hexadecimal/binary files - THexToCanvas is a descendant of TComponent, assign a THexEditor to it, set some properties - and you can paint the hex data to a canvas ( e.g. printer canvas ) - - credits to : - - John Hamm, john@snapjax.com, http://users.snapjax.com/john/ (s.b. for details) - - Christophe LE CORFEC , CLC@khalif.com for his introduction to the EBCDIC format and - the nice idea about half byte insert/delete - - Philippe Chessa , Philippe_Chessa@compuserve.com for his suggestions about AsText, AsHex - and better support for the french keyboard layout - - Daniel Jensen , no_comply@usa.net for octal offset display and the INS-key recognition stuff - - written by Markus Stephany, mirbir.st@t-online.de, http://home.t-online.de/home/mirbir.st - Please don't hesitate to send all suggestions, questions and bug reports to my email adress. - - Hints : - - position markers : - (like shift+ctrl+[0..9] in delphi ide; to have quick access to important lines in the file) - set them via SHIFT+CTRL+[0..9] - set the cursor to one of the stored marker positions via CTRL+[0..9] - - captured keys : - thexeditor parses the following key presses : - - left,right,up,down,end,home,pg.. to change cursor position (with ctrl to go to first/last position) - TAB to change the current field (hex <=> chars) - CTRL+DEL removes the current selection - - ***history : - V1.16 : released feb 02 99 - - added WMGetDlgCode to avoid problems with shortcut-controls on the form - (Merci á Monsieur Chessa for reporting this ) - changed the property ReadOnly to ReadOnlyFile ( to avoid confusion, sorry ) - fixed updating when the font gets changed - added OnKeyPress-support ( now you can modify the key before THexEditor will parse it in this event ) - - added - property WantTabs : Boolean ; if true, than you can navigate between char and hex field with - the TAB key, if not, you can navigate between your form's controls with - the TAB key, to change the current field in THexEditor, you have to use - CTRL+T. - - property ReadOnlyView : Boolean ; - if true, than the text/data in THexEditor can't edited via key presses, - just selection , moving and scrolling are still available - - - V1.15 : released 03/01/99 - - added option odOctal to TOffsetDisplayStyle to display line offset in octal system ("8"-based) - - fixed a problem on creating a THexEditor dynamically - ( thanks to John Shailes , JohnShailes@email.msn.com ) - - added (thanks to Daniel Jensen) - property AllowInsertMode : Boolean ; if this is set to true, THexEditor doesn't overwrite - but insert values at the current cursor position - ( this cannot be set if NoSizeChange is True ) - - property IsInsertMode : Boolean ; ReadOnly, if it returns true, the current mode is - inserting (see above ) - - property AutoCaretMode : Boolean ; if true, the caret will be set to a block - in overwrite mode and to a left line in insert mode - automatically - V1.14 : not released - fixed the problem with the hidden caret on windows nt ( changed the bitmap to an object member) - many thanx to Eric Grange egrange@hotmail.com - - added - property NoSizeChange : Boolean ; if this is set to true, just overwriting is allowed, - no deletion/insertion of data - - - the following items are currently unsupported : - - property VariableLineLength : Boolean ; if true, each line can display a different amount - of bytes (overwrites BytesPerLine) - - property LineLength [ Index : Integer ] : Integer ; to get/set each line's length - - property LineOffset [ Index : Integer ] : Integer ; ReadOnly, to obtain the starting offset - for each line ( useful when working with variable line lengths ) - - procedure SetLineLengths ( aLengths : TList ); to set all lines' length all in one to - different values stored in the aLengths parameter - V1.13 : released 11/07/98 ( thanks to Philippe Chessa Philippe_Chessa@compuserve.com for these suggestions ) - Now also typing shifted characters in the hex field is possible - added - function ConvertHexToBin ( aFrom , aTo : PChar ; const aCount : Integer ; - const SwapNibbles : Boolean ; var BytesTranslated : Integer ) : PChar; - translates things like "a0 00 CCDD ef..." to their binary values and - returns aTO ( aTo may point to the same memory position as aFrom ) - NOTE: this is not an object function ! - - function ConvertBinToHex ( aFrom , aTo : PChar ; const aCount : Integer ; - const SwapNibbles : Boolean ) : PChar; - translates binary data to its hexadecimal representation - aTo should be different from aFrom ( since aFrom would be overwritten - before reading its data ). after doing this a 0# will be stored at the end - of the result - NOTE: this is not an object function ! - - property AsText : string ; read / write THexEditor's Data from / to a String - property AsHex : string ; read / write THexEditor's Data from / to a hex string ("99AABBCC"...) - - property MaskWhiteSpaces : Boolean; if this is true, [#0..#31] chars will be replaced in the char field - with the char set in the MaskChar property - - property MaskChar : Char ; look at MaskWhiteSpaces - - - V1.12 : released 10/25/98 - Removed property OEMTranslate, therefore - Added property Translation: TTranslationType ; this can be set to display chars in various modes, - currently ttAnsi ( no translation ) , ttDos8 ( translation to 8 bit dos ascii - chars ), ttASCII ( translation to plain 7 bit ascii ) , ttMac ( chars will be - converted to Macintosh(TM) charset ) and ttEBCDIC ( Chars will be translated - to IBM(TM)'s ebcdic character set, code page 038 ) are implemented. - property SwapNibbles: Boolean ; if true the Byte value 160dec will be displayed in hex field as "0A" - rather than "A0" - function DeleteNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; - removes 4 bits (1 nibble) at the given position, if HighNibble is true, - bits 16..128 will be deleted else bits 1..8 then shifts the file's contents - behind these bits bitwise to the left (to pos 0 ) - function InsertNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; - inserts 4 bits (1 nibble) at the given position, if HighNibble is true, - 0000 will be inserted at position $80 else at $00 then shifts the file's contents - behind these bits bitwise to the right (to file end ) - procedure ConvertRange ( const aFrom , aTo : Integer ; const aTransFrom , aTransTo : TTranslationType ); - converts the given file-range from one code type to another, possible values - for aTransFrom , aTransTo are : ttAnsi , ttDOS8 , ttASCII , ttMAC , ttEBCDIC - - - V1.11 : released 10/04/98 - Added property BytesPerColumn: Integer; tells THexEditor how many Bytes will build one column in the hex field - (default 2 ); e.g. "0010 202f 304f" or "00 10 20 2f..." if set to 1 - property CaretStyle: TCaretStyle ( csFull, csLeftLine , csBottomLine ) : the caret's style - property OffsetDisplay: TOffsetDisplayStyle ( odHex , odDec , odNone ) : how should the line offset be shown ? - property ShowMarkerColumn : Boolean : if set to true, show a column left to the hex field to display marked lines - function Find ( aBuffer : PChar ; const aCount , aStart , aEnd : Integer ; - const IgnoreCase , SearchText : Boolean ) : Integer; - searches for the stuff in aBuffer from position aStart to Position aEnd and returns the position, - -1 if nothing has been found; if SearchText is True, thexeditor will convert the text to the - specified translation - - function Seek (const aOffset , aOrigin : Integer ; const FailIfOutOfRange : Boolean ) : Boolean - move the cursor position to the given value, if new position is out of file, go to start/end - or return false ( depends on FailIfOutOfRange ), aOffset,aOrigin: look at the help for - TCustomMemoryStream.Seek - - - - - V1.1 : all this nice stuff has been done by John Hamm ! - modified Markus's original version, mostly cosmetic changes - Added: SavetoStream, LoadFromStream - property Colors: TColors; created a TColors type, you can change the following colors: - Background, ChangedBackground, ChangedText, - CursorFrame, EvenColumn, OddColumn, Offset, - PositionBackground, and PositionText - To change the color of the normal text, use THexEditor.Font.Color -// changed to caretstyle mst property FullCaret: Boolean; set to True to have a block caret, False for a line caret - property OffsetSeparator: Char; change the character that trails the offset column -// changed to offsetdisplay mst property ShowOffset: Boolean; set to True to show offset, false hides offset - property FocusFrame: Boolean; set to True to show a Windows focus frame instead of the - solid CursorFrame - - Modified: SavetoFile, LoadFromFile to the Delphi standards (specify filename) - property Filename - read-only, - property GridLineWidth - published - property BytesPerLine - published - - V1.0 beta 1 : first public release 08/14/98 - -*) - -{.$define _debug} //do not remove the dot - - - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, grids; - -const - WM_STATECHANGED = WM_USER +2 ; - - {translation tables from/to windows ansi (~ iso } - - // - macintosh - - ctMacToISO : array [128..255] of Char = ( - #$C4,#$C5,#$C7,#$C9,#$D1,#$D6,#$DC,#$E1,#$E0,#$E2,#$E4,#$E3,#$E5,#$E7,#$E9,#$E8, - #$EA,#$EB,#$ED,#$EC,#$EE,#$EF,#$F1,#$F3,#$F2,#$F4,#$F6,#$F5,#$FA,#$F9,#$FB,#$FC, - #$DD,#$B0,#$A2,#$A3,#$A7,#$80,#$B6,#$DF,#$AE,#$A9,#$81,#$B4,#$A8,#$82,#$C6,#$D8, - #$83,#$B1,#$BE,#$84,#$A5,#$B5,#$8F,#$85,#$BD,#$BC,#$86,#$AA,#$BA,#$87,#$E6,#$F8, - #$BF,#$A1,#$AC,#$88,#$9F,#$89,#$90,#$AB,#$BB,#$8A,#$A0,#$C0,#$C3,#$D5,#$91,#$A6, - #$AD,#$8B,#$B3,#$B2,#$8C,#$B9,#$F7,#$D7,#$FF,#$8D,#$8E,#$A4,#$D0,#$F0,#$DE,#$FE, - #$FD,#$B7,#$92,#$93,#$94,#$C2,#$CA,#$C1,#$CB,#$C8,#$CD,#$CE,#$CF,#$CC,#$D3,#$D4, - #$95,#$D2,#$DA,#$DB,#$D9,#$9E,#$96,#$97,#$AF,#$98,#$99,#$9A,#$B8,#$9B,#$9C,#$9D ); - - ctISOToMac : array [128..255] of Char = ( - #$A5,#$AA,#$AD,#$B0,#$B3,#$B7,#$BA,#$BD,#$C3,#$C5,#$C9,#$D1,#$D4,#$D9,#$DA,#$B6, - #$C6,#$CE,#$E2,#$E3,#$E4,#$F0,#$F6,#$F7,#$F9,#$FA,#$FB,#$FD,#$FE,#$FF,#$F5,#$C4, - #$CA,#$C1,#$A2,#$A3,#$DB,#$B4,#$CF,#$A4,#$AC,#$A9,#$BB,#$C7,#$C2,#$D0,#$A8,#$F8, - #$A1,#$B1,#$D3,#$D2,#$AB,#$B5,#$A6,#$E1,#$FC,#$D5,#$BC,#$C8,#$B9,#$B8,#$B2,#$C0, - #$CB,#$E7,#$E5,#$CC,#$80,#$81,#$AE,#$82,#$E9,#$83,#$E6,#$E8,#$ED,#$EA,#$EB,#$EC, - #$DC,#$84,#$F1,#$EE,#$EF,#$CD,#$85,#$D7,#$AF,#$F4,#$F2,#$F3,#$86,#$A0,#$DE,#$A7, - #$88,#$87,#$89,#$8B,#$8A,#$8C,#$BE,#$8D,#$8F,#$8E,#$90,#$91,#$93,#$92,#$94,#$95, - #$DD,#$96,#$98,#$97,#$99,#$9B,#$9A,#$D6,#$BF,#$9D,#$9C,#$9E,#$9F,#$E0,#$DF,#$D8 ); - - // - ebcdic cp 38 - - ctEBCDICToISO : array [0..255] of Char = ( - #0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - ' ',#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,'.','<','(','+','þ', - '&','&',#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,'!','$','*',')',';',#0 , - '-','/',#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,'|',',','%','_','>','?', - #0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,'`',':','#','@','''','=','"', - #0 ,'a','b','c','d','e','f','g','h','i',#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,'j','k','l','m','n','o','p','q','r',#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,'~','s','t','u','v','w','x','y','z',#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,'A','B','C','D','E','F','G','H','I',#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - #0 ,'J','K','L','M','N','O','P','Q','R',#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - '\',#0 ,'S','T','U','V','W','X','Y','Z',#0 ,#0 ,#0 ,#0 ,#0 ,#0 , - '0','1','2','3','4','5','6','7','8','9',#0 ,#0 ,#0 ,#0 ,#0 ,#0 ); - - ctISOToEBCDIC : array [0..255] of Char = ( - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - '@','Z','','{','[','l','P','}','M',']','\','N','k','`','K','a', - 'ð','ñ','ò','ó','ô','õ','ö','÷','ø','ù','z','^','L','~','n','o', - '|','Á','Â','Ã','Ä','Å','Æ','Ç','È','É','Ñ','Ò','Ó','Ô','Õ','Ö', - '×','Ø','Ù','â','ã','ä','å','æ','ç','è','é',#00,'à',#00,#00,'m', - 'y','','‚','ƒ','„','…','†','‡','ˆ','‰','‘','’','“','”','•','–', - '—','˜','™','¢','£','¤','¥','¦','§','¨','©',#00,'j',#00,'¡',#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00, - #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,'O',#00 ); - -type - - TLongPoint = record - x , y : LongInt; - end; - - TCaretStyle = (csFull , csLeftLine , csBottomLine ); - TOffsetDisplayStyle = (odHex , odDec , odOctal , odNone ); - TTranslationType = (ttAnsi , ttDos8 , ttASCII , ttMac , ttEBCDIC ); - - PUndoRec = ^TUndoRec; - TUndoRec = packed record - Typ : Byte; - Changed : Boolean; - Modified : Boolean; - CurPos : Integer; - C1st : Byte; - CharField : Boolean; - SelS , SelE , SelP , Pos , Count , ReplCount : DWORD; - Buffer : Byte; - end; - - TColors = class(TPersistent) - private - FOffset: TColor; - FOddColumn: TColor; - FOddInverted: TColor; - FEvenColumn: TColor; - FEvenInverted: TColor; - FParent: TControl; - FPositionBackground: TColor; - FCursorFrame: TColor; - FBackground: TColor; - FChangedText: TColor; - FPositionText: TColor; - FChangedBackground: TColor; - protected - procedure SetBackground(const Value: TColor); - procedure SetChangedBackground(const Value: TColor); - procedure SetChangedText(const Value: TColor); - procedure SetCursorFrame(const Value: TColor); - procedure SetPositionBackground(const Value: TColor); - procedure SetPositionText(const Value: TColor); - procedure SetEvenColumn(const Value: TColor); - procedure SetOddColumn(const Value: TColor); - procedure SetOffset(const Value: TColor); - public - constructor Create(Parent: TControl); - published - property Background: TColor read FBackground write SetBackground; - property PositionBackground: TColor read FPositionBackground write SetPositionBackground; - property PositionText: TColor read FPositionText write SetPositionText; - property ChangedBackground: TColor read FChangedBackground write SetChangedBackground; - property ChangedText: TColor read FChangedText write SetChangedText; - property CursorFrame: TColor read FCursorFrame write SetCursorFrame; - property Offset: TColor read FOffset write SetOffset; - property OddColumn: TColor read FOddColumn write SetOddColumn; - property EvenColumn: TColor read FEvenColumn write SetEvenColumn; - end; - - THexEditor = class(TCustomGrid) - private - fCharWidth , fCharHeight : Integer; - fInsertOn : Boolean; - fCaretBitmap : TBitmap; - fColors: TColors; - fBytesPerLine : Integer; - fOffSetDisplayWidth : Integer; - fBPL2 : Integer; - fDataSize : Integer; - fIntFile : TFileStream; - fSwapNibbles : Integer; - fFocusFrame: Boolean; - fUndoMem : TMemoryStream; - fReadOnlyFile : Boolean; - fBytesPerColumn : Integer; - fPosInChars : Boolean; - fIntBuffer : PByteArray; - fIntBufferPos : Integer; - fFileName : string; - fInternalName : string; - fChangedBytes : TBits; - fMarker : array [0..9] of Integer; - fSelST , fSelPO , fSelEN : Integer; - fIsSelecting : Boolean; - fCanUndo : Boolean; - fUndoDesc : string; - fUndoCount : Integer; - fStateChanged : TNotifyEvent; -// fOEMTranslate : Boolean; - fTranslation : TTranslationType; - fModified : Boolean; - fCreateBackup : Boolean; - fBackupExt : string; - FOffsetDisplay: TOffsetDisplayStyle; - FOffsetChar: Char; - fCaretStyle : TCaretStyle; - fShowMarkerCol : Boolean; - fLastKeyWasALT : Boolean; - fMaskWhiteSpaces : Boolean; - fMaskChar : Char; - fNoSizeChange : Boolean; - fVariableLineLength : Boolean; - fOffsets : TList; - fAllowInsertMode : Boolean; - fAutoCaretMode : Boolean; - FWantTabs: Boolean; - FReadOnlyView: Boolean; - property Color; - procedure InternalErase(const BackSp: Boolean); - procedure SetReadOnlyView(const Value: Boolean); - procedure SetCaretStyle(const Value: TCaretStyle); - procedure SetFocusFrame(const Value: Boolean); - procedure SetBytesPerColumn(const Value: Integer); - procedure SetSwapNibbles ( const Value : Boolean ); - function GetSwapNibbles : Boolean; - function GetBytesPerColumn : Integer; - procedure SetShowMarkerColumn( const Value : Boolean ); - procedure SetOffsetDisplayWidth; - procedure SetOffsetChar(const Value: Char); - procedure SetOffsetDisplay(const Value: TOffsetDisplayStyle); - procedure SetColors(const Value: TColors); - procedure SetReadOnlyFile (const aValue : Boolean ); - procedure SetTranslation ( aValue : TTranslationType ); - procedure SetModified ( aValue : Boolean ); - procedure SetBytesPerLine ( aValue : Integer ); - procedure SetChanged ( aPos : Integer ; aValue : Boolean ); - procedure SetNoSizeChange ( const aValue : Boolean ); - procedure SetAllowInsertMode ( const aValue : Boolean ); - function GetIsInsertMode : Boolean; - procedure SetAutoCaretMode ( const aValue : Boolean ); - procedure SetWantTabs(const Value: Boolean); - protected - procedure CreateColoredCaret; - function GetMemory ( aIndex : Integer ):Char; - procedure SetMemory ( aIndex : Integer ; aChar : Char ); - procedure TestStream; - procedure AdjustMetrics; - function GetDataSize : Integer; - procedure CalcSizes; - procedure DrawCell(ACol, ARow: Longint; ARect: TRect; - AState: TGridDrawState); override; - function SelectCell(ACol, ARow: Longint): Boolean; override; -// procedure GetCurrentLine ( aLine : Integer ); - function GetPosAtCursor ( const aCol , aRow : Integer ) : Integer; - function GetCursorAtPos ( aPos : Integer ; aChars : Boolean ) : TLongPoint; - function GetOtherFieldCol ( aCol : Integer ; var Chars : Boolean ) : Integer; - function CheckSelectCell ( aCol , aRow : Integer ) : Boolean; - procedure WMChar(var Msg: TWMChar); message WM_CHAR; - procedure WMSTATECHANGED ( var Msg : TMessage ) ; message WM_STATECHANGED; - procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; - procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; - function GetByteAtPos ( aPos : Integer ) : Byte; - procedure SetByteAtPos ( aPos : Integer ; aByte : Byte ); - procedure GetMemAtPos ( aBuffer : PByteArray ; aPos , aCount : Integer ); - procedure SetMemAtPos ( aBuffer : PByteArray ; aPos , aCount : Integer ); - procedure ChangeByte ( aOldByte , aNewByte : Byte ; aPos , aCol , aRow : Integer ); - procedure KeyDown(var Key: Word; Shift: TShiftState); override; - procedure KeyUp(var Key: Word; Shift: TShiftState); override; - function HasChanged ( aPos : Integer ) : Boolean; - function IsMarkerPos ( aPos : Integer ) : Integer; - function GetMarkerRow ( aWhich : Byte ) : Integer; - function ParseKeyDown ( aShift : TShiftState ; aChar : Char ) : Boolean; - function IsSelected ( aPos : Integer ) :Boolean; - procedure RedrawPos ( aFrom , aTo : Integer ) ; - procedure ResetSelection ( aDraw : Boolean); - procedure ResetUndo; - {$ifdef _debug} - procedure ShowSelState; - {$endif} - procedure Select ( aCurCol , aCurRow , aNewCol , aNewRow : Integer ); - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override; -(* procedure MouseUP(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override;*) - function CreateUndo ( aType : Integer ; aPos , aCount , aReplCount : Integer ) : Boolean; - procedure DoCreateUndo ( aType : Integer ; aPos , aCount , aReplCount : Integer ); - function GetSelStart : Integer; - function GetSelEnd : Integer; - function GetSelCount : Integer; - procedure SetSelStart ( aValue : Integer ); - procedure SetSelEnd ( aValue : Integer ); - procedure SetInCharField ( aValue : Boolean ); - function GetInCharField : Boolean; - procedure Loaded ; override; - procedure CreateWnd ; override; - procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; - procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; - function TranslateToAnsiChar ( aByte : Byte ) : Char ; - function TranslateFromAnsiChar ( aByte : Byte ) : Char; - procedure InternalInsertBuffer ( aBuffer : PChar ; aSize , aPos : Integer ); - procedure InternalAppendBuffer ( aBuffer : PChar ; aSize : Integer ); - procedure MoveFileMem ( aFrom , aTo , aCount : Integer ); - procedure CheckInternalBuffer ( aPos : Integer ); - procedure SetInternalBufferByte ( aPos : Integer ; aByte : Byte ); - procedure InternalGetCurSel ( var aSP , aEP , aCol , aRow : Integer); - procedure InternalDeleteSelection ( aSP , aEP , aNCol , aNRow : Integer ); - procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; - procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL; - function InternalDeleteNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; - function InternalInsertNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; - function CreateShift4BitStream ( const aStart : Integer ; var vName : TFileName ): TFileStream; - procedure InternalConvertRange ( const aFrom , aTo : Integer ; const aTransFrom , aTransTo : TTranslationType ); - function GetMarker (aIndex : Byte ) : Integer; - procedure SetMarker (aIndex : Byte ; const aValue : Integer ); - procedure SetMaskWhiteSpaces (const aValue : Boolean ); - procedure SetMaskChar ( const aValue : Char ); - procedure SetAsText ( const aValue : string ); - procedure SetAsHex ( const aValue : string ); - function GetAsText : string; - function GetAsHex : string; - procedure FreeFile; - procedure SetVariableLineLength ( const aValue : Boolean ); - procedure AdjustLineLengthsCount; - function GetLineLength ( aLine : Integer ) : Integer; - procedure SetLineLength ( aLine , aLength : Integer ); - function GetLineOffset ( aLine : Integer ) : Integer; - function OutOfBounds ( const aCol , aRow : Integer ) : Boolean; - function GetRow ( const aPos : Integer ) : Integer; - procedure StateNotification; - public - { Public-Deklarationen } - constructor Create ( aOwner : TComponent ) ;override; - destructor Destroy ; override; - {$Ifdef _debug} - procedure SaveUndo ( aFileName : TFileName ); //for debugging purposes, do not use it - {$endif} - function Seek (const aOffset , aOrigin : Integer ; const FailIfOutOfRange : Boolean ) : Boolean; - function Find ( aBuffer : PChar ; const aCount , aStart , aEnd : Integer ; // find something in the current file - const IgnoreCase , SearchText : Boolean ) : Integer; //and return the position, -1 if not found - procedure DeleteSelection; // delete the currently selected part of the file (with undo) - function LoadFromStream(Strm: TStream): Boolean; - function LoadFromFile(const Filename: string): Boolean; - function SaveToStream(Strm: TStream): Boolean; - function SaveToFile(const Filename: string): Boolean; - function Undo : Boolean; // if possible, undo last action (multiple undo!) - procedure CreateEmptyFile (const TempName : string ); // create a new, empty file and give it a special filename ( e.g. "untitled 1" ) - function BufferFromFile ( aPos : Integer ; var aCount : Integer ): PChar; // allocates memory for the result and fills it with acount bytes from pos apos - procedure InsertBuffer ( aBuffer : PChar ; aSize , aPos : Integer ); // insert contents of a buffer at the given position - procedure AppendBuffer ( aBuffer : PChar ; aSize : Integer); // store buffer's contents behind the current file - procedure ReplaceSelection ( aBuffer : PChar ; aSize : Integer ); // replace the current selection with buffer's contents - function GetCursorPos : Integer; // the file position where the cursor position points to - function DeleteNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; - function InsertNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; - procedure ConvertRange ( const aFrom , aTo : Integer ; const aTransFrom , aTransTo : TTranslationType ); - procedure ClearOffsets; - procedure SetLineLengths ( aLengths : TList ); - property SelStart : Integer read GetSelStart write SetSelStart; // selection start - property SelEnd : Integer read GetSelEnd write SetSelEnd; // selection End ( can be less than selstart ) - property SelCount : Integer read GetSelCount; // amount of selected bytes (0..n), ReadOnly - property CanUndo : Boolean read fCanUndo; // is undo possible ? - property InCharField : Boolean read GetInCharField write SetInCharField; // is the cursor set to the right (char) field (true ) or to the hex field - property UndoDescription : string read fUndoDesc; // get the undo description string - property ReadOnlyFile : Boolean read fReadOnlyFile write SetReadOnlyFile ;// if the current file is ReadOnly, this is set to true - property Modified : Boolean read fModified write SetModified; // true, if changes have been made - property DataSize : Integer read GetDataSize; // get the size of the file - property Data [ Index : Integer] : Char read GetMemory write SetMemory; // get / set one byte(char) of the file - property AsText : string read GetAsText write SetAsText; // get / set all data from / to a string variable - property AsHex : string read GetAsHex write SetAsHex; // get / set all data from / to a hex string variable - property Canvas; - property Col; - property LeftCol; - property Row; - property TabStops; - property TopRow; - property Filename: string read FFilename; - property Marker [ Index : Byte ] : Integer read GetMarker write SetMarker; - property VariableLineLength : Boolean read fVariableLineLength write SetVariableLineLength; - property LineLength [ Index : Integer ] : Integer read GetLineLength write SetLineLength ; - property LineOffset [ Index : Integer ] : Integer read GetLineOffset ; - property IsInsertMode : Boolean read GetIsInsertMode; - published - { Published-Deklarationen } - property ShowMarkerColumn : Boolean read fShowMarkerCol write SetShowMarkerColumn default True; - property BytesPerColumn : Integer read GetBytesPerColumn write SetBytesPerColumn default 4; - property OnStateChanged : TNotifyEvent read fStateChanged write fStateChanged; // if selection/state has changed (for setting the e.g. undo-menu automatically) - property Translation : TTranslationType read fTranslation write SetTranslation; - property CreateBackup : Boolean read fCreateBackup write fCreateBackup default True; // if true, create backup file on saving modified files - property BackupExtension : string read fBackupExt write fBackupExt; // if above is true, save the backup file with this file name extension - property Align; - property BorderStyle; - property OffsetDisplay: TOffsetDisplayStyle read FOffsetDisplay write SetOffsetDisplay; - property BytesPerLine : Integer read fBytesPerLine write SetBytesPerLine; // get/set how many bytes per line - property CaretStyle: TCaretStyle read FCaretStyle write SetCaretStyle default csFull; - property Colors: TColors read fColors write SetColors; // get/set the colors (descr. at the top of this file) - property Ctl3D; - property DragCursor; - property DragMode; - property Enabled; - property FocusFrame: Boolean read FFocusFrame write SetFocusFrame; - property Font; - property GridLineWidth default 0; - property OffsetSeparator: Char read FOffsetChar write SetOffsetChar; - property SwapNibbles: Boolean read GetSwapNibbles write SetSwapNibbles default False; - property MaskWhiteSpaces : Boolean read fMaskWhiteSpaces write SetMaskWhiteSpaces default True; - property MaskChar : Char read fMaskChar write SetMaskChar default '.'; - property NoSizeChange : Boolean read fNoSizeChange write SetNoSizeChange default False; - property AllowInsertMode : Boolean read fAllowInsertMode write SetAllowInsertMode default False; - property AutoCaretMode : Boolean read fAutoCaretMode write SetAutoCaretMode default True; - property WantTabs : Boolean read FWantTabs write SetWantTabs default True; - property ReadOnlyView : Boolean read FReadOnlyView write SetReadOnlyView default False; - property ParentCtl3D; - property ParentShowHint; - property PopupMenu; - property ScrollBars; - property ShowHint; - property TabOrder; - property TabStop; - property Visible; - property OnClick; - property OnDblClick; - property OnDragDrop; - property OnDragOver; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; - property OnStartDrag; - {for delphi 4} - {$ifdef ver120} - property Anchors; - property BiDiMode; - property Constraints; - property DragKind; - property ParentBiDiMode; - property OnEndDock; - property OnMouseWheel; - property OnMouseWheelDown; - property OnMouseWheelUp; - property OnStartDock; - {$EndIf} - end; - - THexToCanvas = class ( TComponent ) - private - fHexEditor : THexEditor; - fFont : TFont; - fTopM,fLeftM,fBottomM,fRightM : Integer; - fLpP,fBpL,fBpC : Integer; - fOffsDy , fMemDy : TOffsetDisplayStyle; - fCharDy : Boolean; - fOffsCr , fMemCr , fCharCr : Char; - fShrink , fStretch : Boolean; - fSwapNibbles : Boolean; - procedure SetFont ( Value : TFont ); - procedure SetHexEditor ( Value : THexEditor ); - protected - procedure Notification ( aComponent : TComponent ; aOperation : TOperation ) ; Override; - public - Constructor Create ( aOwner : TComponent ) ; override; - Destructor Destroy ; override; - function Draw ( aCanvas : TCanvas ; const aStart , aEnd : Integer ; const TopLine , BottomLine : string ) : Integer; - procedure GetLayout; - property TopMargin : Integer read fTopM write fTopM; - property LeftMargin : Integer read fLeftM write fLeftM; - property RightMargin : Integer read fRightM write fRightM; - property BottomMargin : Integer read fBottomM write fBottomM; - property LinesPerPage : Integer read fLpP; - published - property HexEditor : THexEditor read fHexEditor write SetHexEditor; - property Font : TFont read fFont write SetFont; - property BytesPerLine : Integer read fBpL write fBpL default 16; - property OffsetDisplay : TOffsetDisplayStyle read fOffsDy write fOffsDy default odHex; - property OffsetSeparator : Char read fOffsCr write fOffsCr default ':'; - property MemFieldDisplay : TOffsetDisplayStyle read fMemDy write fMemDy default odHex; - property MemFieldSeparator : Char read fMemCr write fMemCr default ';'; - property DisplayCharField : Boolean read fCharDy write fCharDy default True; - property CharFieldSeparator : Char read fCharCr write fCharCr default #0; - property ShrinkToFit : Boolean read fShrink write fShrink default True; - property StretchToFit : Boolean read fStretch write fStretch default True; - property BytesPerColumn : Integer read fBpC write fBpC default 2; - property SwapNibbles : Boolean read fSwapNibbles write fSwapNibbles default False; - end; - -function Min ( a1,a2:Integer):Integer; -function Max ( a1,a2:Integer):Integer; -function LongPoint ( aX , aY : LongInt ) : TLongPoint; -function IsKeyDown ( aKey : Integer ) : Boolean; - -// translate the buffer to THexEditor's translation mode -procedure TranslateBufferFromAnsi ( const TType : TTranslationType ; aBuffer , bBuffer : PChar ; const aCount : Integer ); - -// translate the buffer to ANSI from THexEditor's translation mode -procedure TranslateBufferToAnsi ( const TType : TTranslationType ; aBuffer , bBuffer : PChar ; const aCount : Integer ); - -// translate a hexadecimal data representation ("a000 cc45 d3 42"...) to its binary values -function ConvertHexToBin ( aFrom , aTo : PChar ; const aCount : Integer ; - const SwapNibbles : Boolean ; var BytesTranslated : Integer ) : PChar; - -// translate binary data to its hex representation -function ConvertBinToHex ( aFrom , aTo : PChar ; const aCount : Integer ; - const SwapNibbles : Boolean ) : PChar; - - -// translate a Integer value to an octal string -function IntToOctal ( const aValue : Integer ) : string; - -{$IFDEF VER120} -// the same for int64 -function Int64ToOctal ( const aValue : Int64 ) : string; -{$ENDIF} - -procedure Register; - -implementation - -const - // undo constants - U_Byte_changed = 0; - U_Byte_removed = 1; - U_Insert_buffer = 2; - U_Replace_Selection = 3; - U_Append_Buffer = 4; - U_Nibble_Insert = 5; - U_Nibble_Delete = 6; - U_Convert = 7; - - UndoSTR : array [U_Byte_changed..U_Convert] of string = ( - 'Byte changed', - 'Byte(s) removed', - 'Insert buffer', - 'Replace selection', - 'Append buffer', - 'Insert nibble', - 'Delete nibble', - 'Convert' ); - - cMax_Undo = 100; // max available undo steps - - // size of the buffer that can hold a part of the current file in memory for faster access - cBuf_Size = 65536; - - HexCHL = '0123456789abcdef'; - HexCHU= '0123456789ABCDEF'; - HexCHA= HexCHL+HexCHU; -{_______________________________________________________________________} - -function Invert(Color: TColor): TColor; -begin - Result := RGB(255 - GetRValue(Color), 255 - GetGValue(Color), 255 - GetBValue(Color)); -end; - -{_______________________________________________________________________} - -// translate the buffer from ANSI to the given translation mode -procedure TranslateBufferFromAnsi ( const TType : TTranslationType ; aBuffer , bBuffer : PChar ; const aCount : Integer ); -var - pct : Integer; - pch : Char ; -begin - case TType - of - ttAnsi : Move ( aBuffer^ , bBuffer^ , aCount ); - ttDOS8, - ttASCII : CharToOEMBuff ( aBuffer , bBuffer , aCount ); - ttMAC : if aCount > 0 - then - for pct := 0 to Pred ( aCount ) - do begin - pch := aBuffer [pct]; - if pch < #128 - then - bBuffer [ pct] := pch - else - bBuffer [ pct ] := ctISOToMac [ Ord ( pch ) ]; - end; - ttEBCDIC : if aCount > 0 - then - for pct := 0 to Pred ( aCount ) - do - bBuffer [ pct] := ctISOToEBCDIC[Ord(aBuffer [pct])]; - end; -end; - -{_______________________________________________________________________} - -// translate the buffer to ANSI from the given translation mode -procedure TranslateBufferToAnsi ( const TType : TTranslationType ; aBuffer , bBuffer : PChar ; const aCount : Integer ); -var - pct : Integer; - pch : Char ; -begin - case TType - of - ttAnsi : Move ( aBuffer^ , bBuffer^ , aCount ); - ttDOS8, - ttASCII : OEMToCharBuff ( aBuffer , bBuffer , aCount ); - ttMAC : if aCount > 0 - then - for pct := 0 to Pred ( aCount ) - do begin - pch := aBuffer [pct]; - if pch < #128 - then - bBuffer [ pct] := pch - else - bBuffer [ pct ] := ctMacToISO [ Ord ( pch ) ]; - end; - ttEBCDIC : if aCount > 0 - then - for pct := 0 to Pred ( aCount ) - do - bBuffer [ pct] := ctEBCDICToISO[Ord(aBuffer [pct])]; - end; -end; - -{_______________________________________________________________________} - -function FillLeft (const FillChar : Char ; const IntStr : string ; const MaxLen : Integer):string; -begin - Result := IntStr; - while Length ( Result ) < MaxLen - do - Result := FillChar+Result; -end; - -{_______________________________________________________________________} - -function OEMChar ( aByte : Byte ) : Char; -var - psr : string; -begin - psr := Char(aByte)+#0; - OEMToChar ( @psr[1] , @psr[1] ); - Result := psr[1]; -end; - -{_______________________________________________________________________} - -function CharOEM ( aByte : Byte ) : Char; -var - psr : string; -begin - psr := Char(aByte)+#0; - CharToOEM ( @psr[1] , @psr[1] ); - Result := psr[1]; -end; - -{_______________________________________________________________________} - -procedure Register; -begin - RegisterComponents('Merkes'' Pages', [THexEditor , THexToCanvas]); -end; - -function GetTempName : string; -var - pPT : string; -begin - SetLength ( pPT , MAX_PATH+1); - SetLength ( pPt , GetTempPath ( MAX_PATH , @pPt[1] )); - pPT := Trim ( pPT ); - if pPT[Length ( ppT)] <> '\' - then - pPT := pPT+'\'; - repeat - Result := pPT+IntToHex(GetTickCount , 8)+'.MPHT'; - until not FileExists ( Result ); -end; - -function CanOpenFile ( const aName : TFileName; var ReadOnly : Boolean ) :Boolean; -var - fHandle : THandle ; -begin - Result := False; - ReadOnly := True; - if FileExists ( aName ) - then begin - fHandle := FileOpen ( aName , fmOpenRead or fmShareDenyNone ); - if fHandle <> INVALID_HANDLE_VALUE - then begin - FileClose ( fHandle ); - Result := True; - fHandle := FileOpen ( aName , fmOpenReadWrite); - if fHandle <> INVALID_HANDLE_VALUE - then begin - FileClose ( fHandle ); - ReadOnly := False; - end; - end; - end; -end; - -function IsKeyDown ( aKey : Integer ) : Boolean; -begin - Result := (GetKeyState( aKey) and (not 1)) <> 0; -end; - -function Min ( a1,a2:Integer):Integer; -begin - if a1 < a2 - then - Result := a1 - else - Result := a2; -end; - -function Max ( a1,a2:Integer):Integer; -begin - if a1 > a2 - then - Result := a1 - else - Result := a2; -end; - -function LongPoint ( aX , aY : LongInt ) : TLongPoint; -begin - Result.x := aX; - Result.y := aY; -end; - -// translate a hexadecimal data representation ("a000 cc45 d3 42"...) to its binary values -function ConvertHexToBin ( aFrom , aTo : PChar ; const aCount : Integer ; - const SwapNibbles : Boolean ; var BytesTranslated : Integer ) : PChar; -var - lHi : Boolean; - lCT : Integer; - lBy : Byte; - lNb : Char; -begin - Result := aTo; - BytesTranslated := 0; - lHi := True; - lBy := 0; - for lCT := 0 to Pred ( aCount ) - do - if Pos ( aFrom[lCT] , HexCHA ) <> 0 - then begin - lNB := UpCase ( aFrom[lCT] ); - if lHi - then - lBY := ((Pos ( lNB , HexCHU) -1 )*16) - else - lBy := lBy or ((Pos ( lNB , HexCHU) -1 )); - lHI := not lHI; - if lHI - then begin - if SwapNibbles - then - aTo [BytesTranslated] := Char(((lBy and 15)*16) or ((lBy and $f0) shr 4)) - else - aTo [BytesTranslated] := Char(lBY); - Inc ( BytesTranslated); - end; - end; -end; - -// translate binary data to its hex representation -function ConvertBinToHex ( aFrom , aTo : PChar ; const aCount : Integer ; - const SwapNibbles : Boolean ) : PChar; -var - lCT : Integer; - lBy : Byte; - lCX : Integer; -begin - Result := aTo; - lCX := 0; - for lCT := 0 to Pred ( aCount ) - do begin - lBy := Ord ( aFrom[lCT] ); - if SwapNibbles - then begin - aTo[lCX] := UpCase ( HexCHU[(lBY and 15)+1] ); - aTo[lCX+1] := UpCase ( HexCHU[(lBY shr 4)+1] ) - end - else begin - aTo[lCX+1] := UpCase ( HexCHU[(lBY and 15)+1] ); - aTo[lCX] := UpCase ( HexCHU[(lBY shr 4)+1] ) - end; - Inc ( lCX , 2 ); - end; - aTO [ lCX ] := #0; -end; - -{* octal stuff *} - -const gOctalChars = '01234567'; - -// translate a Integer value to an octal string -function IntToOctal ( const aValue : Integer ) : string; -var - lVal : Integer; -begin - Result := ''; - lVal := aValue; - repeat - Result := gOctalChars[(lVal mod 8)+1] + Result; - lVal := lVal shr 3; - until lVal = 0; - Result := '0'+Result; -end; - -{$IFDEF VER120} -// the same for int64 -function Int64ToOctal ( const aValue : Int64 ) : string; -var - lVal : Int64; -begin - Result := ''; - lVal := aValue; - repeat - Result := gOctalChars[(lVal mod 8)+1] + Result; - lVal := lVal shr 3; - until lVal = 0; - Result := '0'+Result; -end; -{$ENDIF} - - - -(* THexEditor Implementation *) - -constructor THexEditor.Create ( aOwner : TComponent ) ; -begin - inherited Create ( aOwner ); - fColors := TColors.Create(Self); - - ParentColor := False; - fIntFile := nil; - fUndoMem := nil; - - Color := fColors.Background; - - fCharWidth := -1; - fShowMarkerCol := True; - fOffSetDisplayWidth := -1; - fBytesPerLine := 16; - fOffsetChar := ':'; - fOffsetDisplay := odHex; - FCaretStyle := csFull; - FFocusFrame := True; - fSwapNibbles := 0; - FFilename := '---'; - - Font.Name := 'Courier'; - Font.Size := 12; - BorderStyle := bsSingle; - DefaultDrawing := False; - Options := [goVertLine, goHorzLine,goTabs,gOThumbTracking]; - GridLineWidth := 0; - fBytesPerColumn := 4; - CTL3D := False; - Cursor := crIBeam; - fChangedBytes := TBits.Create; - FillChar ( fMarker[0] , SizeOf ( fMarker ) , $ff ); - fSelST := -1; - fSelPO := -1; - fSelEN := -1; - fIsSelecting := False; - ResetUndo; - DefaultColWidth := 0; - DefaultRowHeight := 0; - ColCount := fBytesPerLine*3+3; - RowCount := 1; - fTranslation := ttAnsi; - fCanUndo := False; - fModified := False; - fReadOnlyFile := True; - fCreateBackup := True; - fBackupExt := '.bak'; - fInterNalName := GetTempName; - fIntBufferPos := -1; - GetMem ( fIntBuffer , cBuf_Size ); - fDataSize := -1; - fBPL2 := 2*fBytesPerLine; - fLastKeyWasALT := False; - fMaskWhiteSpaces := True; - fMaskChar := '.'; - fCaretBitmap := TBitmap.Create; - fNoSizeChange := False; - fVariableLineLength := False; - fOffsets := TList.Create; - fAllowInsertMode := False; - fInsertOn := False; - fAutoCaretMode := True; - fWantTabs := True; - fReadOnlyView := False; -end; - -procedure THexEditor.FreeFile; -begin - if fIntFile <> nil - then begin - // ~~~ask for saving changes - fIntFile.Size := 0; - fIntFile.Free; - fIntFile := nil; - end; -end; - -destructor THexEditor.Destroy ; -begin - FreeFile; - if fUndoMem <> nil - then begin - fUndoMem.Size := 0; - fUndoMem.Free; - fUndoMem := nil; - end; - fChangedBytes.Free; - if FileExists ( fInterNalName ) - then - DeleteFile ( fInternalName ); - - FreeMem ( fIntBuffer , cBuf_Size ); - - fColors.Free; - fCaretBitmap.Free; - fOffsets.Clear; - fOffsets.Free; - inherited Destroy; -end; - -procedure THexEditor.AdjustMetrics; -var - pCT : Integer; -begin - Canvas.Font.Assign ( Font ); - fCharWidth := Canvas.TextWidth ( 'w' ); - - SetOffsetDisplayWidth; - ColWidths[1] := fCharWidth * Integer(fShowMarkerCol); - - for pCT := 0 to Pred ( fBytesPerLine * 2) - do - if (((pCT+2) mod fBytesPerColumn) = 1) - then - ColWidths[pCT+2] := fCharWidth *2 - else - ColWidths[pCT+2] := fCharWidth ; - - for pCT := fBytesPerLine * 2 to (fBytesPerLine*3) - do - ColWidths[pCT+2] := fCharWidth; - - fCharHeight := Canvas.TextHeight( 'yY')+2; - DefaultRowHeight := fCharHeight; -end; - -function THexEditor.GetDataSize : Integer; -begin - Result := fDataSize; - if (fDataSize = -1) or (fIntBufferPos = -1) - then begin - if fIntFile = nil - then - Result := 0 - else - Result := fIntFile.Size; - fDataSize := Result - end -end; - -procedure THexEditor.CreateEmptyFile; -begin - FreeFile; - - FFilename := TempName; - ResetUndo; - ResetSelection(False); - fChangedBytes.Size := 0; - CalcSizes; - fModified := False; - fReadOnlyFile := True; - MoveColRow ( 2 , 0 , True , True ); -end; - -function THexEditor.SaveToStream(Strm: TStream): Boolean; -var - MemStrm: TMemoryStream; - pCr : TCursor; -begin - Result := True; - pCr := Cursor; - Cursor := crHourGlass; - MemStrm := TMemoryStream.Create; - try - try - fIntFile.Position := 0; - MemStrm.LoadFromStream(fIntFile); - MemStrm.SaveToStream(Strm); - except - Result := False; - end; - finally - MemStrm.Free; - Cursor := pCr; - end; -end; - -function THexEditor.SaveToFile(const Filename: string): Boolean; -var - pCr : TCursor; -begin - Result := True; - pCr := Cursor; - Cursor := crHourGlass; - try - if fCreateBackup and fModified and ( fFileName = FileName ) - then - if not CopyFile ( PChar ( FileName ) , PChar ( ChangeFileExt ( FileName , fBackupExt)) , False ) - then - Exit; - - try - fIntFile.Free; - Result := CopyFile ( PChar ( fInternalName ) , PChar ( FileName ) , False ); - except - Result := False; - end; - - fIntFile := tFileStream.Create ( fInternalName , fmOpenReadWrite ); - - if Result - then begin - fChangedBytes.Size := 0; - fModified := False; - fReadOnlyFile := False; - fFilename := Filename; - ResetUndo; - end; - finally - Cursor := pCr; - Invalidate; - end; -end; - -function THexEditor.LoadFromStream(Strm: TStream): Boolean; -var - pCR : TCursor; - MemStrm: TMemoryStream; -begin - - FreeFile; - - pCR := Cursor; - Cursor := crHourGlass; - - MemStrm := TMemoryStream.Create; - try - MemStrm.CopyFrom(Strm, Strm.Size - Strm.Position); - MemStrm.SaveToFile(fInternalName); - finally - MemStrm.Free; - end; - - SetFileAttributes ( PChar ( fInterNalName ) , 0 ); - - fIntFile := TFileStream.Create ( fInterNalName , fmOpenReadWrite ); - try - fIntFile.Position := 0; - Result := True; - finally - Cursor := pCR; - ResetUndo; - fChangedBytes.Size := 0; - CalcSizes; - fModified := False; - fIsSelecting := False; - MoveColRow ( 2 , 0 , True , True ); - end; -end; - -function THexEditor.LoadFromFile(const Filename: string): Boolean; -var - pCR : TCursor; -begin - Result := True; - - if CanOpenFile(FileName, fReadOnlyFile) then begin - FreeFile; - pCR := Cursor; - Cursor := crHourGlass; - CopyFile (PChar (FileName), PChar(fInternalName), False); - SetFileAttributes ( PChar ( fInterNalName ) , 0 ); - fIntFile := TFileStream.Create ( fInterNalName , fmOpenReadWrite ); - try - fIntFile.Position := 0; - FFilename := Filename; - Result := True; - finally - Cursor := pCR; - ResetUndo; - fChangedBytes.Size := 0; - CalcSizes; - fModified := False; - fIsSelecting := False; - MoveColRow ( 2 , 0 , True , True ); - end; - end -end; - -procedure THexEditor.CalcSizes; - - function CalcVarRowCount : Integer; - var - pCT,pPos : Integer; - begin - pCT := DataSize div fBytesPerLine; - pPos := 0; - while pPos < DataSize - do begin - pPos := LineOffset [ pCT]; - Inc ( pCT ); - end; - Result := Max( 0 , pCT-1); - end; - - -begin - fDataSize := -1; - - if fChangedBytes.Size > DataSize - then - fChangedBytes.Size := DataSize; - - if DataSize < 1 - then begin - FixedCols := 2; - RowCount := 1; - ColCount := fBytesPerLine*3+3; - if fOffsets.Count = 0 - then - LineLength[0] := fBytesPerLine; - - end - else - begin - if not fVariableLineLength - then - RowCount := (DataSize + (fBytesPerLine-1)) div fBytesPerLine - else - RowCount := CalcVarRowCount; - - ColCount := fBytesPerLine*3+3; - FixedCols := 2; - end; - FixedRows := 0; - fIntBufferPos := -1; - AdjustMetrics; -end; - -function THexEditor.TranslateFromAnsiChar ( aByte : Byte ) : Char; -begin - case fTranslation - of - ttAnsi : begin - if aByte < 32 - then - Result := #0 - else - Result := Char ( aByte ); - end; - ttDos8, - ttASCII : begin - if ((fTranslation = ttDos8) or (aByte < 128)) and (aByte > 31) - then - Result := CharOem ( aByte ) - else - Result := #0; - end; - ttMac : begin - if aByte < 32 - then - Result := #0 - else - if aByte < 128 - then - Result := Char ( aByte ) - else - Result := ctISOToMac [ aByte ]; - end; - ttEBCDIC : begin - Result := ctISOToEBCDIC[ aByte ]; - end; - else - Result := #0; - end; -end; - - -function THexEditor.TranslateToAnsiChar ( aByte : Byte ) : Char ; -begin - case fTranslation - of - ttAnsi : begin - Result := Char ( aByte ); - end; - ttDos8, - ttASCII : begin - Result := OemChar ( aByte ); - if ((fTranslation = ttASCII) and (aByte > 127)) - then - Result := fMaskChar; - end; - ttMac : begin - if aByte < 128 - then - Result := Char ( aByte ) - else - Result := ctMacToISO [ aByte ]; - end; - ttEBCDIC : begin - Result := ctEBCDICToISO[ aByte ]; - if Result = #0 - then - Result := fMaskChar; - end; - else - Result := fMaskChar; - end; - - if fMaskWhiteSpaces and (Result < #32 ) - then - Result := fMaskChar; - -end; - -function THexEditor.OutOfBounds ( const aCol , aRow : Integer ) : Boolean; -// check when VariableLineLength is true, if this given point is not a valid cell -var - pInCH : Boolean; - pMaxCol : Integer; -begin - Result := False; - if not fVariableLineLength - then - Exit; - - pInCH := aCol > (2 + fBPL2); - - if pInCH - then - pMaxCol := (fBytesPerLine *2) + 2 +LineLength[aRow] - else - pMaxCol := (LineLength[aRow]*2)+1 ; - - Result := (aCol > pMaxCol); - -end; - - - -procedure THexEditor.DrawCell( ACol, ARow: Longint; ARect: TRect; - AState: TGridDrawState); -var - pTMP : Boolean; - pOddCol: Boolean; - pChan: Boolean; - pSZ : Integer; - pAP : Integer; - pCO : string; - pSFR : string; - pCanText,pCanBrush : TColor; - - procedure _TextOut; - begin - with Canvas - do begin - SetTextColor ( Handle , ColorToRGB ( pCanText )); - SetBKColor ( Handle , ColorToRGB ( pCanBrush )); - ExtTextOut( Handle, aRect.Left, aRect.Top, ETO_CLIPPED or ETO_OPAQUE, @aRect, PChar(pco), - Length(pco), nil); - end; - end; - -begin - if (aRow = 0) and (DataSize < 1) - then begin - pCO := ' '; - if aCol = 0 - then - case fOffsetDisplay - of - odHex : pCO := '0x0'+ FOffsetChar; - odDec : pCO := '0'+FOffsetChar; - odOctal: pCO := 'o 0'+FOffsetChar; - end; - - pCanBrush := fColors.Background; - pCanText := Colors.Offset; - _TextOut; - if aCol = 2 - then begin - SetCaretPos ( aRect.Left , aRect.Top ); - end; - Exit; - end; - - pAP := LineOffset[aRow]; - - if aCol = 0 - then begin - case fOffsetDisplay - of - odNone : pCO := ' '; - odHex : pCO := '0x'+IntToHex( pAP , fOffsetDisplayWidth-3)+ FOffsetChar; - odDec : pCO := FillLeft(' ',IntToStr( pAP ), fOffsetDisplayWidth-1)+FOffsetChar; - odOctal: pCO := 'o '+FillLeft ( '0',IntToOctal ( pAP ) , fOffsetDisplayWidth-3)+fOffsetChar; - end; - pCanBrush := fColors.Background; - pCanText := Colors.Offset; - _TextOut; - Exit; - end; - - // testen ob Marker hier sitzt - // test if the marker have been positonned - if (aCol = 1) - then begin - if (IsMarkerPos ( aRow) > -1) - then begin - pCanText := fColors.PositionText; - pCanBrush := fColors.PositionBackground; - - pSZ := Canvas.Font.Size; - pSFR := Canvas.Font.Name; - Canvas.Font.Name := 'Arial'; - Canvas.Font.Size := Round ( psZ * 0.75); - pCO := IntToStr(IsMarkerPos ( aRow)); - _TextOut; - Canvas.Font.Size := pSZ; - Canvas.Font.Name := psFr; - end - else begin - pCanBrush := fColors.Background; - pCanText := Font.Color; - pCO := ' '; - _TextOut; - end; - Exit; - end; - - // empty cell ... xx xx_xxxx... - if (aCol = fBPL2+2) - then begin - pCanBrush := fColors.Background; - pCanText := Font.Color; - pCO := ' '; - _TextOut; - Exit; - end; - - CheckInternalBuffer ( pAP ); - - pAP := GetPosAtCursor ( aCol , aRow ); - - if (pAP >= DataSize) or (fVariableLineLength and OutOfBounds ( aCol , aRow )) - then begin - pCanBrush := fColors.Background; - pCanText := Font.Color; - pCO := ' '; - _TextOut; - Exit; - end; - - if not fPosInChars - then begin // partie hexadecimale - if ((aCol-2) mod 2) = fSwapNibbles - then - pCO := HexCHU[fIntBuffer[pAP - fIntBufferPos] shr 4+1] - else - pCO := HexCHU[fIntBuffer[pAP - fIntBufferPos] and 15+1] - end - else - pCO := TranslateToAnsiChar ( fIntBuffer[pAP - fIntBufferPos] ); - - // testen ob byte geändert - // test if byte have been changed - pChan := (HasChanged ( pAP ) ); - pOddCol := (((aCol-2) div fBytesPerColumn) mod 2)=0; - - if pChan - then begin - pCanText := fColors.ChangedText; - pCanBrush := fColors.ChangedBackground; - end - else begin - pCanBrush := fColors.Background; - pCanText := Font.Color; - - if not fPosInChars - then - if pOddCol - then - pCanText := Colors.OddColumn - else - pCanText := Colors.EvenColumn; - end; - - if (fSelPO <> -1) and IsSelected ( pAP ) - then begin - pSZ := pCanBrush; - pCanBrush := pCanText; - pCanText := pSZ; - - if not (PChan or fPosInChars) - then - if pOddCol - then - pCanText := Colors.FOddInverted - else - pCanText := Colors.FEvenInverted; - end; - - _TextOut ; - - if aRow = Row - then begin - if (aCol = Col) - then begin // Cursor ausgeben - if Focused - then begin - SetCaretPos ( aRect.Left , aRect.Top ); - end - end - else - if (GetOtherFieldCol ( Col , pTMP) = aCol) and Focused - then begin - if FFocusFrame - then - Canvas.DrawFocusRect(Rect(aRect.Left,aRect.Top,aRect.Left+fCharWidth,aRect.Bottom)) - else begin - Canvas.Pen.Color := fColors.CursorFrame; - Canvas.Brush.Style := bsClear; - Canvas.Rectangle ( aRect.Left , aRect.Top , aRect.Left+fCharWidth , aRect.Bottom ); - end; - end - end; -end; - -{$ifdef _debug} -procedure THexEditor.ShowSelState; -begin - if fIsSelecting - then begin - TForm(Owner).Caption := 'a' - end - else - TForm(Owner).Caption := '-'; -end; -{$endif} - -function THexEditor.SelectCell(ACol, ARow: Longint): Boolean; -var - pRow : Integer; - pRect : TRect; - pTMP : Boolean; - pOC : Integer; -begin - pRow := Row; - {$ifdef _debug} - ShowSelState; - {$endif} - if DataSize > 0 - then - Result := CheckSelectCell ( aCol , aRow ) - else begin - if not ((aCol = 2) and (aRow = 0)) - then - Result := False - else begin - Result := True; - Exit; - end; - end; - if Result - then begin - // cursor in anderem feld löschen - pOC := GetOtherFieldCol ( Col , pTMP ); - pRect := CellRect ( pOC , pRow); - InvalidateRect ( Handle , @pRect , False ); - - // cursor in anderem feld setzen - pOC := GetOtherFieldCol ( aCol , pTMP ); - pRect := CellRect ( pOC , aRow); - InvalidateRect ( Handle , @pRect , False ); - - if fIsSelecting - then - Select ( Col , Row , aCol , aRow ) - else - ResetSelection( True); - - // caret neu setzen - pRect := CellRect ( aCol , aRow); - SetCaretPos ( pRect.Left , pRect.Top ); - end; -end; -// Obtient la position dans le fichier à partir de la position du curseur -function THexEditor.GetPosAtCursor ( const aCol , aRow : Integer ) : Integer; -begin - fPosInChars := aCol > (2 + fBPL2); - Result := LineOffset[aRow]; - if fPosInChars - then - Result := Result+ (aCol - (3 + fBPL2)) - else - Result := Result+ ((aCol -2) div 2); - - if Result < 0 - then - Result := 0; -end; - -function THexEditor.GetRow ( const aPos : Integer ) : Integer; -var - pct : Integer; -begin - if not fVariableLineLength - then - Result := aPos div fBytesPerLine - else begin - Result := 0; - for pct := 0 to RowCount - 1 - do begin - if LineOffset[pct] > aPos - then begin - Result := pct -1; - Break; - end; - Result := RowCount -1; - end; - end; -end; - -function THexEditor.GetCursorAtPos ( aPos : Integer ; aChars : Boolean ) : TLongPoint; -var - pct : Integer; -begin - if aPos < 0 - then begin - Result.y := 0; - Result.x := 2; - Exit; - end; - - Result.y := GetRow ( aPos ); - if not fVariableLineLength - then - pct := aPos mod fBytesPerLine - else - pct := aPos - LineOffset[Result.y]; - - if aChars - then - Result.x := pct + (3 + fBPL2) - else - Result.x := (pct *2 ) +2; - -end; - -function THexEditor.GetOtherFieldCol ( aCol : Integer ; var Chars : Boolean ) : Integer; -var - pct : Integer; -begin - Chars := aCol > (2 + fBPL2); - if Chars - then begin - pct := (aCol - (3 + fBPL2)); - Result := (pct * 2)+2; - end - else begin - pct := ((aCol -2) div 2); - Result := pct + (3 + fBPL2); - end; -end; - -function THexEditor.CheckSelectCell ( aCol , aRow : Integer ) : Boolean; -var - pTP : TLongPoint; -const - pCan : Boolean = True; - pClicked : Boolean = False; -begin - Result := Inherited SelectCell ( aCol , aRow ); - - if (Result and fVariableLineLength and OutOfBounds ( aCol , aRow )) - then - Result := False; - - if not pCan - then - Exit; - try - pCan := False; - if Result - then begin - // überprüfen, ob linke maustaste oder shift gedrückt, sonst selection zurücksetzen - if not (IsKeyDown ( VK_SHIFT) or IsKeyDown ( VK_LBUTTON) ) - then - ResetSelection ( True ); - - // überprüfen, ob außerhalb der DateiGröße - if GetPosAtCursor ( aCol , aRow ) >= DataSize - then begin - GetPosAtCursor ( Col , Row ); - pTP := GetCursorAtPos ( DataSize - 1 , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - Result := False; - end - else - if aCol = (2 + fBPL2 ) - then begin - Result := False; - if IsKeyDown ( VK_LBUTTON ) - then begin - aCol := aCol -1; - aCol := Max ( 2 , aCol ); - MoveColRow ( aCol , aRow , True , True ); - Exit; - end; - end; - - end; - finally - pCan := True; - end; - -end; - -procedure THexEditor.WMChar(var Msg: TWMChar); -var - pPos : Integer; - pCH : Char; - pOldBT , pNewBT : Byte; - pTP : TLongPoint; -begin - pCH := Char ( Msg.CharCode ); - if Assigned ( OnKeyPress ) - then - OnKeyPress ( Self , pCH ); - - if fReadOnlyView - then - Exit; - - {$ifdef _debug} - TForm(Owner).Caption := Char ( Msg.CharCode); - {$endif} - pPos := GetPosAtCursor ( Col , Row ); - if (pPos >= DataSize ) and not IsInsertMode - then - Exit; - if not fPosInChars // Zone d'affichage hexadecimale - then begin - // hex-eingabe, nur 0..9 , a..f erlaubt - if Pos ( pCH , HexCHA ) <> 0 - then begin - pCH := UpCase ( pCH ); - - if not IsInsertMode - then - ResetSelection ( True ); - - pTP := GetCursorAtPos ( pPos , fPosInChars ); - // Obtient la valeur du byte dans le fichier (OldByte) - if DataSize > pPos - then - pOldBT := GetByteAtPos ( pPos ) - else - pOldBT := 0; - - if (pTP.x = (Col - fSwapNibbles)) or (SelCount <> 0) - then - pNewBT := pOldBT and 15 + ((Pos ( pCH , HexCHU) -1 ) * 16) - else - pNewBT := (pOldBT and $F0) + (Pos ( pCH , HexCHU) -1 ); - - if IsInsertMode and ((pTP.x = Col ) or (SelCount > 0)) - then begin - - if fSwapNibbles = 0 - then - pNewBt := pNewBt and $f0 - else - pNewBT := pNewBt and $0f; - - if DataSize = 0 - then - AppendBuffer ( @pNewBT , 1 ) - else - if SelCount = 0 - then - InsertBuffer(@pNewBT, 1, pPos) - else - ReplaceSelection ( @pNewBT , 1 ); - end - else begin - ChangeByte(pOldBT, pNewBT, pPos, Col, Row); - if IsInsertMode and (pTP.x <> Col) and (pPos+1 = DataSize) - then begin - pNewBT := 0; - AppendBuffer ( @pNewBT , 1 ); - Exit;//ParseKeyDown ( [] , Char(VK_LEFT) ); - end; - end; - - ParseKeyDown ( [] , Char(VK_RIGHT) ); - end; - end - else begin - // zeichen-eingabe, alle zeichen erlaubt - if not fLastKeyWasALT // if the key has been entered via ALT + NUMPAD (0..9), make no translation (except oem to ansi) - then - pCH := TranslateFromAnsiChar ( Ord(pCH) ) - else - pCH := CharOEM(Ord(pCH)); // this doesn't work with all chars, but i don't know how to solve it - - if (pch < #32) and (not fLastKeyWasALT) - then - Exit; - - fLastKeyWasALT := False; - - if not IsInsertMode - then - ResetSelection ( True ); - - pTP := GetCursorAtPos ( pPos , fPosInChars); - pOldBT := GetByteAtPos ( pPos ); - - if IsInsertMode - then begin - if SelCount > 0 - then - ReplaceSelection ( @pCH , 1 ) - else - InsertBuffer(@pCH, 1, pPos) - end - else - ChangeByte(pOldBT, Ord(pCH), pPos, Col, Row); - ParseKeyDown ( [] , Char(VK_RIGHT) ); - end; -end; - -procedure THexEditor.SetByteAtPos ( aPos : Integer ; aByte : Byte ); -begin - fIntFile.Position := aPos; - fIntFile.Write ( aByte , SizeOf ( Byte ) ); -end; - -function THexEditor.GetByteAtPos ( aPos : Integer ) : Byte; -begin - fIntFile.Position := aPos; - fIntFile.Read ( Result , SizeOf ( Byte ) ); -end; - -procedure THexEditor.GetMemAtPos ( aBuffer : PByteArray ; aPos , aCount : Integer ); -begin - fIntFile.Position := aPos; - fIntFile.Read ( aBuffer^ , aCount ); -end; - -procedure THexEditor.SetMemAtPos ( aBuffer : PByteArray ; aPos , aCount : Integer ); -begin - fIntFile.Position := aPos; - fIntFile.Write ( aBuffer^ , aCount ); -end; - -{-------------------------------------------------------------------------------} -// *** procedure THexEditor.ChangeByte*** -// Change la valeur du byte -// Renseigne la structure Undo -{-------------------------------------------------------------------------------} -procedure THexEditor.ChangeByte ( aOldByte , aNewByte : Byte ; aPos , aCol , aRow : Integer ); -var - pRect : TRect; - pTMP : Boolean; - pCol : Integer; - pTP : TLongPoint; -begin - if aOldByte = aNewByte - then - Exit; - - if not CreateUndo ( U_Byte_changed , aPos , 1 , 0) - then - Exit; - - // Ecrit dans le fichier - SetByteAtPos ( aPos , aNewByte ); - SetInternalBufferByte ( aPos , aNewByte ); - if not IsInsertMode - then - fChangedBytes.Bits[aPos] := True; - pTP := GetCursorAtPos ( aPos , False ); - aCol := pTP.x; - pCol := GetOtherFieldCol ( aCol , pTMP ); - pRect := BoxRect ( aCol , aRow , aCol+1 , aRow ); - InvalidateRect ( Handle , @pRect , False ); - pRect := BoxRect ( pCol , aRow , pCol , aRow ); - InvalidateRect ( Handle , @pRect , False ); -end; - -function THexEditor.ParseKeyDown ( aShift : TShiftState ; aChar : Char ) : Boolean; - - function CheckIfLastCol ( const aCol , aRow : Integer ) : Boolean; - begin - Result := (not OutOfBounds ( aCol , aRow )) and OutOfBounds ( aCol+1 , aRow ); - end; - - function GetLastCol ( const aCol , aRow : Integer ) : Integer; - begin - if aCol > (2 + fBPL2) - then - Result := 3+fBPL2 - else - Result := 2; - while not((not OutOfBounds ( Result , aRow )) and OutOfBounds ( Result+1 , aRow )) - do - Inc ( Result ); - end; - - -var - pCT : Integer; - pTP : TLongPoint; - pRow : Integer; - pLastCol : Boolean; -begin - Result := False; - pLastCol := False; - - if not ((aShift <> [] ) or (aChar = #16)) - then - if not IsInsertMode - then - ResetSelection( True); - - if aChar = Char ( VK_PRIOR) - then begin - if fVariableLineLength - then - pLastCol := CheckIfLastCol (Col , Row ); - - if ssCtrl in aShift - then begin - // go to the first visible line - pRow := TopRow; - pCT := Col; - if pRow > -1 - then begin - if fVariableLineLength and pLastCol - then - pCT := GetLastCol ( pCT , pRow ) - else - while OutOfBounds ( pCT , pRow ) - do - Dec ( pCT ); - - - MoveColRow ( pCT , pRow , True , True ); - end; - end - else begin - // scroll up one page - pRow := Max ( 0 , Row - VisibleRowCount+1); - TopRow := Max ( 0 , TopRow - VisibleRowCount+1); - pCT := Col; - if pRow > -1 - then begin - if fVariableLineLength and pLastCol - then - pCT := GetLastCol ( pCT , pRow ) - else - while OutOfBounds ( pCT , pRow ) - do - Dec ( pCT ); - - MoveColRow ( pCT , pRow , True , True ); - end; - - end; - - Result := True; - end; - - if aChar = Char ( VK_NEXT ) - then begin - if fVariableLineLength - then - pLastCol := CheckIfLastCol (Col , Row ); - if ssCtrl in aShift - then begin - // go to the Last visible line - pRow := Min ( RowCount - 1 , TopRow+VisibleRowCount-1); - pCT := Col; - if pRow > -1 - then begin - if fVariableLineLength and pLastCol - then - pCT := GetLastCol ( pCT , pRow ) - else - while OutOfBounds ( pCT , pRow ) - do - Dec ( pCT ); - MoveColRow ( pCT , pRow , True , True ); - end; - end - else begin - // scroll down one page - pRow := Min ( RowCount - 1 , Row + VisibleRowCount-1); - TopRow := Min ( Max ( 0 , RowCount - VisibleRowCount ) , TopRow + VisibleRowCount-1); - pCT := Col; - if pRow > -1 - then begin - if fVariableLineLength and pLastCol - then - pCT := GetLastCol ( pCT , pRow ) - else - while OutOfBounds ( pCT , pRow ) - do - Dec ( pCT ); - - MoveColRow ( pCT , pRow , True , True ); - end; - - end; - - Result := True; - end; - - - - if aChar = Char ( VK_HOME ) - then begin - GetPosAtCursor ( Col , Row ); - if (ssCtrl in aShift ) - then begin // strg+pos1 - if not fPosInChars - then - MoveColRow ( 2,0 , True,True ) - else - MoveColRow ( GetOtherFieldCol ( 2 , fPosInChars ) , 0 , True , True ); - end - else - begin // normaler zeilenstart - if not fPosInChars - then - MoveColRow ( 2,Row , True,True ) - else - MoveColRow ( GetOtherFieldCol ( 2 , fPosInChars ) , Row , True , True ); - end; - Result := True; - end; - - if aChar = Char ( VK_END ) - then begin - GetPosAtCursor ( Col , Row ); - if (ssCtrl in aShift ) - then begin // strg+end - pTP := GetCursorAtPos ( DataSize - 1 , fPosInChars); - MoveColRow ( pTP.x,pTP.y , True,True ) - end - else - begin // normales zeilenende - if not fPosInChars - then begin - pCT := GetPosAtCursor (2 , Row+1 )-1; - if pCT >= DataSize - then - pCT := DataSize -1; - pTP := GetCursorAtPos ( pCT , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True,True ) - end - else begin - pCT := GetPosAtCursor (2 , Row+1 )-1; - if pCT >= DataSize - then - pCT := DataSize -1; - pTP := GetCursorAtPos ( pCT , True ); - MoveColRow ( pTP.x , pTP.y , True,True ) - end - end; - Result := True; - end; - - if (aChar = Char ( VK_LEFT )) and ( not (ssCTRL in aShift )) - then begin - pCT := GetPosAtCursor ( Col , Row ) -1; - if fPosInChars - then begin - if pCT < 0 - then - pCT := 0; - pTP := GetCursorAtPos ( pCT , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - end - else - begin - pct := pct +1; - pTP := GetCursorAtPos ( pCT , False ); - if pTP.x < Col - then - MoveColRow ( Col - 1 , Row , True , True ) - else begin - pCT := pCT -1; - if pCT >= 0 - then begin - pTP := GetCursorAtPos ( pCT , fPosInChars ); - MoveColRow ( pTP.x+1 , pTP.y , True , True ); - end; - end - - end; - Result := True; - end; - - if (aChar = Char ( VK_RIGHT )) and ( not (ssCTRL in aShift )) - then begin - pCT := GetPosAtCursor ( Col , Row ) +1; - if fPosInChars - then begin - if pCT >= DataSize - then - pCT := DataSize-1; - pTP := GetCursorAtPos ( pCT , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - end - else - begin - pct := pct -1; - pTP := GetCursorAtPos ( pCT , False ); - if pTP.x = Col - then - MoveColRow ( Col + 1 , Row , True , True ) - else begin - pCT := pCT +1; - if pCT < DataSize - then begin - pTP := GetCursorAtPos ( pCT , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - end; - end - - end; - Result := True; - end; - - if (aChar = Char ( VK_RIGHT )) and (ssCTRL in aShift ) - then begin - pCT := ColCount - 1; - while OutOfBounds ( pCT , Row ) - do - Dec ( pCT ); - MoveColRow ( pCT , Row , True , True ); - Result := True; - end; - - if (aChar = Char ( VK_DOWN )) and ( not (ssCTRL in aShift )) - then begin - if fVariableLineLength - then - pLastCol := CheckIfLastCol (Col , Row ); - - pRow := Row +1; - pCT := Col; - if pRow < RowCount - then begin - if fVariableLineLength and pLastCol - then - pCT := GetLastCol ( pCT , pRow ) - else - while OutOfBounds ( pCT , pRow ) - do - Dec ( pCT ); - MoveColRow ( pCT , pRow , True , True ); - end; - Result := True; - end; - - if (aChar = Char ( VK_UP )) and ( not (ssCTRL in aShift )) - then begin - if fVariableLineLength - then - pLastCol := CheckIfLastCol (Col , Row ); - - pRow := Row -1; - pCT := Col; - if pRow > -1 - then begin - if fVariableLineLength and pLastCol - then - pCT := GetLastCol ( pCT , pRow ) - else - while OutOfBounds ( pCT , pRow ) - do - Dec ( pCT ); - MoveColRow ( pCT , pRow , True , True ); - end; - Result := True; - end; - - if ( ssCtrl in aShift ) and ( aChar = 'T' ) - then begin // ctrl+T - if DataSize > 0 - then - Col := GetOtherFieldCol ( Col , fPosInChars ); - Result := True; - end; - - if ( (aShift = []) or (aShift = [ssShift]) ) and ( aChar = Char ( VK_TAB ) ) - then begin // tab-taste - if DataSize > 0 - then - Col := GetOtherFieldCol ( Col , fPosInChars ); - Result := True; - end - else - if (aShift = [ssCtrl , ssShift]) and (( aChar >='0') and (aChar <='9')) - then begin // marker setzen - SetMarker ( Ord ( aChar) - Ord ( '0' ) , Row ); - Result := True; - end - else - if (aShift = [ssCtrl]) and (( aChar >='0') and (aChar <='9')) - then begin // marker zurückholen - ResetSelection( True ); - pRow := GetMarkerRow ( Ord ( aChar) - Ord ( '0' ) ); - if pRow < RowCount - then - MoveColRow ( 2 , pRow , True , True) - else - SetMarker ( Ord ( aChar) - Ord ( '0' ) , 1); - Result := True; - end - else - if (aShift = [ssShift]) and (aChar = #16) - then begin // Selection Starten - if not fIsSelecting - then - ResetSelection( True ); - fIsSelecting := True; - Result := True; - end; - -end; - -procedure THexEditor.KeyUp(var Key: Word; Shift: TShiftState); -begin - fLastKeyWasALT := Key = VK_MENU; // to check if the key in char field has been entered via ALT+NUMPAD (0..9) - {$ifdef _debug} - TForm ( Owner).Caption := IntToStr(Key ); - {$endif} - inherited KeyUp ( Key , Shift ); -end; - -procedure THexEditor.KeyDown(var Key: Word; Shift: TShiftState); -var - pChar : Char; -begin - {$ifdef _debug} - TForm(Owner).Caption := 'KeyDown : '+Char ( Key ); - {$endif} - if Key = VK_INSERT - then begin - Key := 0; - fInsertOn := not fInsertOn ; - if fAutoCaretMode - then - SetAutoCaretMode ( fAutoCaretMode ); - fChangedBytes.Size := 0; - Invalidate; - StateNotification; - Exit; - end; - - pChar := Char ( Key ); - - if Key = 8 - then begin //BACKSP - if (IsInsertMode and (not fReadOnlyView)) - then begin - Key := 0; - if SelCount > 0 - then - DeleteSelection; - InternalErase(true) - end - else Key := VK_Left; - end; - - if ((Key = VK_DELETE) and (not fReadOnlyView)) - then begin - Key := 0; - if (Shift = [ssCtrl] ) or ((SelCount > 0) and IsInsertMode) - then - DeleteSelection - else - if IsInsertMode - then - InternalErase ( False ); - end; - - if ParseKeyDown ( Shift , pChar ) - then - Key := 0 - else - inherited KeyDown ( Key , Shift ); - {$ifdef _debug} - ShowSelState; - {$endif} -end; - -function THexEditor.HasChanged ( aPos : Integer ) : Boolean; -begin - Result := False; - if IsInsertMode - then - Exit; - - if fChangedBytes.Size > aPos - then - Result := fChangedBytes.Bits[aPos]; -end; - -function THexEditor.IsMarkerPos ( aPos : Integer ) : Integer; -var - pct : Integer; -begin - Result := -1; - for pCT := 0 to 9 - do - if aPos = fMarker[pCT] - then begin - Result := pCT; - Exit; - end; -end; - -function THexEditor.GetMarker (aIndex : Byte ) : Integer; -begin - if aIndex > 9 - then - Raise Exception.Create ( 'SetMarker : Invalid marker index' ); - - Result := fMarker[aIndex] ; -end; - - -procedure THexEditor.SetMarker (aIndex : Byte ; const aValue : Integer ); -begin - if aIndex > 9 - then - Raise Exception.Create ( 'SetMarker : Invalid marker index' ); - - if fMarker[aIndex] <> aValue - then begin - fMarker[aIndex] := aValue; - Invalidate; - end; -end; - -function THexEditor.GetMarkerRow ( aWhich : Byte ) : Integer; -begin - Result := Row; - if fMarker[aWhich] <> -1 - then - Result := fMarker[aWhich]; -end; - -function THexEditor.IsSelected ( aPos : Integer ) :Boolean; -begin - Result := False; - if (fSelPO <> -1) and (aPos >= fSelST) and (aPos <= fSelEN) - then - Result := True; -end; - -procedure THexEditor.Select ( aCurCol , aCurRow , aNewCol , aNewRow : Integer ); - -var - pOST , pOEN , pNAP : Integer; - -begin - pOEN := fSelEN; - pOST := fSelST; - pNAP := GetPosAtCursor ( aNewCol , aNewRow ); - if fSelPO = -1 - then begin - fSelPO := GetPosAtCursor ( aCurCol , aCurRow ); - // überprüfen, ob in insert mode - if IsInsertMode - then begin - //falls von hinten nach vorn, dann letztes Byte nicht markieren - if fSelPO > (pNAP) - then - fSelPO := fSelPO -1 - else // letztes byte nicht mehr markieren, basta - if fSelPO < ( pNAP) - then - pNAP := pNAP -1; - end; - pOST := pNAP; - pOEN := pNAP; - fSelST := Min ( pOST , fSelPO); - fSelEN := Max ( fSelPO , pOEN ); - RedrawPos ( fSelST , fSelEN ); - end - else begin - // testen, ob neue selection /\ liegt als fSelPO - // wenn ja, dann start = sel, ende = selpo - if pNAP < fSelPO - then begin - fSelST := pNAP; - fSelEN := fSelPO; - RedrawPos ( Min ( fSelST , pOST ) , Max ( fSelST , pOST )); - RedrawPos ( Min ( fSelEN , pOEN ) , Max ( fSelEN , pOEN )); - end - else begin - // überprüfen, ob in insert mode - if IsInsertMode - then - pNAP := pNAP -1; - fSelEN := pNAP; - fSelST := fSelPO; - RedrawPos ( Min ( fSelST , pOST ) , Max ( fSelST , pOST )); - RedrawPos ( Min ( fSelEN , pOEN ) , Max ( fSelEN , pOEN )); - end; - end; - - StateNotification; -end; - -procedure THexEditor.RedrawPos ( aFrom , aTo : Integer ) ; -var - pR : TRect; -begin - aFrom := GetRow ( aFrom); - aTo := GetRow( aTo); - pR := BoxRect ( 2 , aFrom , ColCount -1 , aTo ); - InvalidateRect ( Handle , @pR , False ); -end; - -procedure THexEditor.ResetSelection ( aDraw : Boolean ); -var - pOldFrom , pOldTo : Integer; -begin - fIsSelecting := False; - pOldFrom := fSelST; - pOldTo := fSelEN; - fSelST := -1; - fSelPO := -1; - fSelEN := -1; - if aDraw - then - RedrawPos ( pOldFrom, pOldTo ); - StateNotification; -end; - -procedure THexEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - if Button = mbLeft - then begin - ResetSelection( True ); - if not (ssDouble in Shift) - then - fIsSelecting := True; - end; - {$ifdef _debug} - ShowSelState; - {$endif} -end; - -procedure THexEditor.InternalGetCurSel ( var aSP , aEP , aCol , aRow : Integer); -var - pTP : TLongPoint; -begin - if fSelPO = -1 - then begin - aSP := GetPosAtCursor ( Col , Row ); - aEP := aSP+1; - aCOL := Col; - aROW := Row; - end - else - begin - aSP := fSelST; - aEP := fSelEN+1; - GetPosAtCursor ( Col , Row ); - pTP := GetCursorAtPos ( fSelST , fPosInChars ); - aCOL := pTP.x; - aROW := ptp.y; - end; - if fChangedBytes.Size > aSP - then - fChangedBytes.Size := asp; -end; - -function THexEditor.CreateShift4BitStream ( const aStart : Integer ; var vName : TFileName ): TFileStream; -var - pbt1,pBt2 : Byte; - par : array [0..511] of Byte; - pct : Integer; -begin - Result := nil; - if aStart >= DataSize - then - Exit; - vName := GetTempName; - Result := TFileStream.Create ( vName , fmCreate ); - Result.Position := 0; - fIntFile.Position := aStart; - pBT1 := 0; - while fIntFile.Position < DataSize - do begin - FillChar ( par[0] , 512 , 0 ); - fIntFile.Read ( par[0] , 512 ); - for pct := 0 to 511 - do begin - pBT2 := par[pct] and 15; - par[pct] := (par[pct] shr 4) or (pBT1 shl 4 ); - pBT1 := pBT2; - end; - Result.Write ( par[0] , 512 ); - end; - Result.Position := 0; -end; - - - - -function THexEditor.InternalInsertNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; -var - pOldCur : TCursor; - fST : TFileStream; - pName : TFileName; - pOldSize : Integer; - pBT : Byte; -begin - Result := False; - TestStream; - - if DataSize = 0 - then - Exit; - - pOldCur := Cursor; - pOldSize := fIntFile.Size; - Cursor := crHourGlass; - try - // nun zuerst alle restlichen bits verschieben - fIntFile.Position := aPos; - fIntFile.Read ( pBT , 1 ); - - fST := CreateShift4BitStream ( aPos , pName ); - with fST - do try - fIntFile.Position := aPos; - fIntFile.CopyFrom ( fST , fST.Size ); - finally - Free; - DeleteFile ( pName ); - end; - fIntFile.Position := aPos; - if HighNibble - then - pBT := pBT shr 4 - else - pBT := pBT and 240; - fIntFile.Write ( pBT , 1 ); - Result := True; - fIntFile.Size := pOldSize+1; - finally - Cursor := pOldCur; - end; -end; - -function THexEditor.InsertNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; -const - Byt : Byte = 0; -begin - Result := False; - - if DataSize < 1 - then begin - ResetSelection ( False ); - AppendBuffer ( @Byt , 1 ); - Result := True; - Exit; - end; - - if (aPos >= DataSize ) or (aPos < 0 ) - then - Exit; - - if not CreateUndo ( U_Nibble_Insert , aPos , 0 , 0 ) - then - Exit; - - ResetSelection ( False ); - Result := InternalInsertNibble ( aPos , HighNibble ); - - if Result and (fChangedBytes.Size >= (aPos)) - then - fChangedBytes.Size := aPos; - - fIntBufferPos := -1; - CalcSizes ; -end; - -function THexEditor.InternalDeleteNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; -var - pOldCur : TCursor; - fST : TFileStream; - pName : TFileName; - pOldSize : Integer; - pBT1,pBT2 : Byte; -begin - Result := False; - TestStream; - - if DataSize = 0 - then - Exit; - - pOldCur := Cursor; - pOldSize := fIntFile.Size; - Cursor := crHourGlass; - try - // nun zuerst alle restlichen bits verschieben - fIntFile.Position := aPos; - fIntFile.Read ( pBT1 , 1 ); - - fST := CreateShift4BitStream ( aPos , pName ); - with fST - do try - fIntFile.Position := aPos; - Position := 1; - fIntFile.CopyFrom ( fST , fST.Size -1); - finally - Free; - DeleteFile ( pName ); - end; - fIntFile.Position := aPos; - if not HighNibble - then begin - fIntFile.Read ( pBT2 , 1 ); - fIntFile.Seek(-1 , soFromCurrent ); - pBT1 := (pBT1 and 240) or (pBT2 and 15); - fIntFile.Write ( pBT1 , 1 ); - end; - Result := True; - fIntFile.Size := pOldSize; - finally - Cursor := pOldCur; - end; -end; - -function THexEditor.DeleteNibble ( const aPos : Integer ; const HighNibble : Boolean ) : Boolean; -begin - Result := False; - - if (aPos >= DataSize ) or (aPos < 0 ) - then - Exit; - - if not CreateUndo ( U_Nibble_Delete , aPos , 0 , 0 ) - then - Exit; - - ResetSelection ( False ); - Result := InternalDeleteNibble ( aPos , HighNibble ); - - if Result and (fChangedBytes.Size >= (aPos)) - then - fChangedBytes.Size := aPos; - - fIntBufferPos := -1; - CalcSizes ; - -end; - -procedure THexEditor.InternalConvertRange ( const aFrom , aTo : Integer ; const aTransFrom , aTransTo : TTranslationType ); -var - pSize : Integer; - pBUF : PChar; - pOCR : TCursor; -begin - pSize := (aTo-aFrom)+1; - pOCR := Cursor; - Cursor := crHourGlass; - GetMem ( pBUF , pSize ); - try - fIntFile.Position := aFrom; - fIntFile.Read ( pBUF^, pSize ); - - TranslateBufferToAnsi ( aTransFrom , pBUF , pBUF , pSize ); - TranslateBufferFromAnsi ( aTransTo , pBUF , pBUF , pSize ); - - fIntFile.Position := aFrom; - fIntFile.Write (pBUF^, pSize ); - finally - FreeMem ( pBUF , pSize ); - Cursor := pOCR; - end; -end; - - - -procedure THexEditor.ConvertRange ( const aFrom , aTo : Integer ; const aTransFrom , aTransTo : TTranslationType ); -begin - if aFrom > aTo - then - Exit; - - if aTransFrom = aTransTo - then - Exit; - - if (aTo >= DataSize ) or (aFrom < 0 ) - then - Exit; - - if not CreateUndo ( U_Convert , aFrom , (aTo-aFrom)+1 , 0 ) - then - Exit; - - InternalConvertRange ( aFrom , aTo , aTransFrom , aTransTo ); - - - fIntBufferPos := -1; - Invalidate; - -end; - - -procedure THexEditor.InternalDeleteSelection ( aSP , aEP , aNCol , aNRow : Integer ); -var - pTP : TLongPoint; -begin - if aEP <= ( DataSize - 1) - then - MoveFileMem ( aEP , aSP , DataSize - aEP ); - fIntFile.Size := DataSize - (aEp-aSP); - aEP := GetPosAtCursor ( aNCol , aNRow ); - if aEP >= DataSize - then begin - pTP := GetCursorAtPos ( DataSize - 1 , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - end - else - MoveColRow ( aNCol , aNRow , True , True ); - - CalcSizes; - ResetSelection( False ); - - Invalidate; -end; - -procedure THexEditor.DeleteSelection; -var - pSP , pEP : Integer; - pNCol , pNROW : Integer; -begin - - InternalGetCurSel ( pSP , pEP , pNCOL , pNROW ); - if not CreateUndo ( U_Byte_removed , pSP , pEP-pSP , 0) - then - Exit; - - InternalDeleteSelection ( pSP , pEP , pNCOL , pNROW ); -end; - -function THexEditor.CreateUndo ( aType : Integer ; aPos , aCount , aReplCount : Integer ) : Boolean; -begin - Result := False; - if DataSize > 0 - then - Result := True; - - if not Result - then - if (aType = U_Insert_buffer) or (aType = U_Append_buffer) - then - Result := True; - - // check for NoSizeChange - if fNoSizeChange and Result - then - if (aType = U_Byte_removed ) or - (aType = U_Insert_buffer ) or - (aType = U_Append_Buffer ) or - (aType = U_Nibble_Insert ) or - (aType = U_Nibble_Delete) or - ((aType = U_Replace_Selection) and (aCount <> aReplCount)) - then - Result := False; - - if Result - then - fCanUndo := Result; - - if Result - then begin - DoCreateUndo ( aType , aPos , aCount , aReplCount ); - fModified := True; - end; - StateNotification; -end; - -procedure THexEditor.ResetUndo; -begin - fCanUndo := False; - fUndoDesc := 'No Undo'; - fUndoCount := 0; - if fUndoMem <> nil - then begin - fUndoMem.Size := 0; - fUndoMem.Free; - fUndoMem := nil; - end; - - if Assigned ( fStateChanged) - then - fStateChanged ( self ); -end; - -function THexEditor.GetSelStart : Integer; -begin - if fSelPO = -1 - then begin - Result := GetPosAtCursor ( Col , Row ); - end - else - Result := fSelPO; -end; - -function THexEditor.GetSelEnd : Integer; -begin - if fSelPO = -1 - then - Result := GetPosAtCursor ( Col , Row ) - else begin - Result := fSelEN; - if fSelPO = fSelEN - then - Result := fSelST; - end; -end; - -procedure THexEditor.SetSelStart ( aValue : Integer ); -var - pTP : TLongPoint; -begin - if (aValue < 0) or (aValue >= DataSize ) - then - raise Exception.Create ( 'Invalid SelStart' ) - else - begin - ResetSelection( True); - GetPosAtCursor ( Col , Row ); - pTP := GetCursorAtPos ( aValue , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - end; -end; - -procedure THexEditor.SetSelEnd ( aValue : Integer ); -var - pTP : TLongPoint; -begin - if (aValue < 0) or ( aValue >= DataSize ) - then - raise Exception.Create ( 'Invalid SelEnd' ) - else begin - ResetSelection ( True ); - GetPosAtCursor ( Col , Row ); - pTP := GetCursorAtPos ( aValue , fPosInChars); - Select ( Col , Row , pTP.x , pTP.y ); - end; -end; - -procedure THexEditor.SetInCharField ( aValue : Boolean ); -begin - if DataSize < 1 - then - Exit; - GetPosAtCursor ( Col , Row ); - if fPosInChars <> aValue - then - MoveColRow ( GetOtherFieldCol ( Col , fPosInChars ) , Row , True , True ); -end; - -function THexEditor.GetInCharField : Boolean; -begin - Result := False; - if DataSize < 1 - then - Exit; - GetPosAtCursor ( Col , Row ); - Result := fPosInChars; -end; - -procedure THexEditor.Loaded ; -begin - inherited; - CreateEmptyFile( 'Untitled' ); -end; - -procedure THexEditor.CreateWnd ; -begin - inherited; - if (csDesigning in ComponentState) or ( fFileName = '---' ) - then - CreateEmptyFile( 'Untitled' ); -end; - -procedure THexEditor.WMSetFocus(var Msg: TWMSetFocus); -begin - inherited; - CreateColoredCaret; - SetCaretPos ( -50 , -50 ); - ShowCaret ( Handle ); - Invalidate; -end; - -procedure THexEditor.WMKillFocus(var Msg: TWMKillFocus); -begin - inherited; - HideCaret ( Handle ); - DestroyCaret ( ); - fIsSelecting := False; - Invalidate; -end; - -procedure THexEditor.WMSTATECHANGED ( var Msg : TMessage ) ; -begin - if Msg.WParam = 7 - then - if Assigned ( fStateChanged) - then - fStateChanged ( self ); -end; - -procedure THexEditor.SetTranslation ( aValue : TTranslationType ); -begin - if fTranslation <> aValue - then begin - fTranslation := aValue; - Invalidate; - end; -end; - -procedure THexEditor.SetModified ( aValue : Boolean ); -begin - fModified := aValue; - if not aValue - then begin - fCanUndo := False; - fChangedBytes.Size := 0; - Invalidate; - end; -end; - -procedure THexEditor.SetBytesPerLine ( aValue : Integer ); -var - pPS,pSP,pSS,pSE : Integer; - pTP : TLongPoint; -begin - if (aValue < 1) or (aValue > 256) - then - raise Exception.Create ( 'Invalid BytesPerLine argument' ) - else - if fBytesPerLine <> aValue - then begin - LockWindowUpdate ( Handle ); - ClearOffsets; - fVariableLineLength := False; - pSP := fSelPO; - pSS := fSelST; - pSE := fSelEN; - pPS := GetPosAtCursor ( Col , Row ); - fBytesPerLine := aValue; - fBPL2 := aValue * 2; - CalcSizes ; - pTP := GetCursorAtPos ( pPs , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - fSelPO := pSP; - fSelST := pSS; - fSelEN := pSE; - LockWindowUpdate ( 0 ); - end; -end; - -procedure THexEditor.InternalAppendBuffer ( aBuffer : PChar ; aSize : Integer ); -var - pCT : Integer; -begin - TestStream; - - if DataSize = 0 - then begin - fIntFile.Position := 0; - fChangedBytes.Size := 0; - end; - - pCT := DataSize; - fIntFile.Size := pCT + aSize; - - SetMemAtPos ( PByteArray(aBuffer ), pCT , aSize ); - CalcSizes; -end; - -procedure THexEditor.InternalInsertBuffer ( aBuffer : PChar ; aSize , aPos : Integer ); -var - pCT : Integer; -begin - TestStream; - - if DataSize = 0 - then begin - fIntFile.Position := 0; - fChangedBytes.Size := 0; - end; - - pCT := DataSize; - fIntFile.Size := pCT + aSize; - - if aPos < pct - then // nur, wenn nicht hinter streamende, dann platz schaffen - MoveFileMem ( aPos , aPos+aSize , DataSize - aPos -aSize); - - SetMemAtPos ( PByteArray(aBuffer ), aPos , aSize ); - CalcSizes; -end; - -procedure THexEditor.InsertBuffer ( aBuffer : PChar ; aSize , aPos : Integer ); -var - pCT : Integer; -begin - - if not CreateUndo ( U_Insert_buffer , aPos , aSize , 0) - then - Exit; - - InternalInsertBuffer ( aBuffer , aSize , aPos ); - - if fChangedBytes.Size >= (aPos) - then - fChangedBytes.Size := aPos; - - pCT := GetPosAtCursor ( Col , Row ); - if pCT = aPos - then begin - fSelPO := aPos; - fSelST := aPos; - fSelEN := aPos+aSize-1; - StateNotification; - end; - Invalidate; - -end; - -procedure THexEditor.AppendBuffer ( aBuffer : PChar ; aSize : Integer); -var - pCT : Integer; - pTP : TLongPoint; -begin - - if not CreateUndo ( U_Append_buffer , DataSize , aSize , 0) - then - Exit; - - if fChangedBytes.Size >= (DataSize) - then - fChangedBytes.Size := DataSize; - - pCT := DataSize; - InternalAppendBuffer ( aBuffer , aSize ); - - GetPosAtCursor ( Col , Row ); - pTP := GetCursorAtPos ( pCT , fPosInChars ); - MoveColRow ( pTP.x , pTP.y , True , True ); - fSelPO := pCT; - fSelST := pCT; - fSelEN := pCT+aSize-1; - StateNotification; - Invalidate; - -end; - - -procedure THexEditor.ReplaceSelection ( aBuffer : PChar ; aSize : Integer ); -var - pSP , pEP , pCol , pRow : Integer; - pCT : Integer; - pOldCol , pOldRow : Integer; -begin - // auswahl berechnen - if fSelPO = -1 - then - InsertBuffer ( aBuffer , aSize , GetSelStart ) - else begin - - if fNoSizeChange - then begin - if aSize > SelCount - then - aSize := SelCount - else - if SelCount > aSize - then begin - SelStart := Min ( SelStart , SelEnd ); - SelEnd := SelStart + aSize-1; - end; - end; - - if not CreateUndo ( U_Replace_selection , fSelST , aSize , SelCount) - then - Exit; - - // zuerst aktuelle auswahl löschen - pOldCol := Col; - pOldRow := Row; - InternalGetCurSel ( pSP , pEP , pCol , pRow ); - InternalDeleteSelection ( pSP , pEP , pCol , pRow ); - InternalInsertBuffer ( aBuffer , aSize , pSP ); - if fChangedBytes.Size >= pSP - then - fChangedBytes.Size := Max ( 0 , pSP ); - pCT := GetPosAtCursor ( pOldCol , pOldRow ); - if (pCT = pSP) and (DataSize > pCT ) - then begin - MoveColRow ( pOldCol , pOldRow , True , True ); - fSelPO := pSP; - fSelST := pSP; - fSelEN := pSP+aSize-1; - StateNotification; - end; - end; -end; - -procedure THexEditor.DoCreateUndo ( aType : Integer ; aPos , aCount , aReplCount : Integer ); - -procedure FillBuffer ( var aBuffer : TUndoRec ; aSize : Integer ); -var - pTP : TLongPoint; -begin - FillChar ( aBuffer , aSize , 0 ); - aBuffer.Typ := aType; - aBuffer.CurPos := GetPosAtCursor ( Col , Row ); - if not fPosInChars - then begin - ptp := GetCursorAtPos ( aBuffer.CurPos , fPosInChars ); - aBuffer.C1st := Col - pTP.x; - end; - aBuffer.CharField := fPosInChars ; - aBuffer.SelS := fSelST; - aBuffer.SelE := fSelEN; - aBuffer.SelP := fSelPO; - aBuffer.Pos := aPos; - aBuffer.Count := aCount; - aBuffer.ReplCount := aReplCount; - aBuffer.Modified := fModified; -end; - -procedure DeleteFirstUndo; -var - pSK : Integer; - pCT : Integer; - pPT : Pointer; -begin - fUndoMem.Position := fUndoMem.Size; - pCT := fUndoMem.Position; - while fUndoMem.Position <> 0 - do begin - fUndoMem.Seek ( -4 , soFromCurrent ); - fUndoMem.Read ( pSK , 4 ); - pCT := fUndoMem.Position; - fUndoMem.Seek ( -pSK , soFromCurrent ); - end; - Integer(pPT) := Integer(fUndoMem.Memory)+pCT; - - Move ( pPT^, fUndoMem.Memory^, fUndoMem.Size - PCT ); - fUndoMem.Size := fUndoMem.Size - pCT; - fUndoMem.Position := fUndoMem.Size; - Dec ( fUndoCount ); -end; - -var - pBuf : PUndoRec; - pAR : PByteArray; -begin - fUndoDesc := UndoSTR [ aType]; - - if fUndoMem = nil - then - fUndoMem := TMemoryStream.Create; - - fUndoMem.Position := fUndoMem.Size; - - Inc (fUndoCount); - - if fUndoCount > cMax_Undo - then - DeleteFirstUndo; - - case aType of - U_Byte_changed : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - pBuf.Buffer := GetByteAtPos ( aPos ); - pBuf.Changed := HasChanged ( aPos ); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec) ); - aPos := SizeOf ( TUndoRec)+4; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec ) ); - end; - end; - U_Byte_removed : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) + aCount -1 ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - pAR := @pBuf.Buffer; - GetMemAtPos ( pAR , aPos , aCount ); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec)+aCount -1 ); - aPos := SizeOf ( TUndoRec)+4+aCount-1; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec )+aCount -1 ); - fIntBufferPos := -1; - end; - end; - U_Insert_Buffer : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec) ); - aPos := SizeOf ( TUndoRec)+4; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec )+aCount -1 ); - fIntBufferPos := -1; - end; - end; - U_Replace_selection : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) + aReplCount -1 ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - pAR := @pBuf.Buffer; - GetMemAtPos ( pAR , aPos , aReplCount ); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec)+aReplCount -1 ); - aPos := SizeOf ( TUndoRec)+4+aReplCount-1; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec )+aReplCount -1 ); - fIntBufferPos := -1; - end; - end; - U_Append_buffer : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec) ); - aPos := SizeOf ( TUndoRec)+4; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec ) ); - fIntBufferPos := -1; - end; - end; - U_Nibble_Insert : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - pBuf.Buffer := GetByteAtPos ( aPos ); - pBuf.Changed := HasChanged ( aPos ); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec) ); - aPos := SizeOf ( TUndoRec)+4; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec ) ); - end; - end; - U_Nibble_Delete : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - pBuf.Buffer := GetByteAtPos ( aPos ); - pBuf.Changed := HasChanged ( aPos ); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec) ); - aPos := SizeOf ( TUndoRec)+4; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec ) ); - end; - end; - U_Convert : begin - GetMem ( pBuf , SizeOf ( TUndoRec ) + aCount -1 ); - try - FillBuffer ( pBuf^ , SizeOf ( TUndoRec )); - pAR := @pBuf.Buffer; - GetMemAtPos ( pAR , aPos , aCount ); - fUndoMem.Write ( pBuf^ , SizeOf ( TUndoRec)+aCount -1 ); - aPos := SizeOf ( TUndoRec)+4+aCount-1; - fUndoMem.Write ( aPos , 4 ); - finally - FreeMem ( pBuf , SizeOf ( TUndoRec )+aCount -1 ); - fIntBufferPos := -1; - end; - end; - end; - -end; - -function THexEditor.Undo : Boolean; - -procedure SetBuffer ( aBuffer : TUndoRec); -var - pTP : TLongPoint; -begin - pTP := GetCursorAtPos ( aBuffer.CurPos , aBuffer.CharField); - if not aBuffer.CharField - then - if DataSize > 0 - then - pTP.x := pTP.x+aBuffer.C1st; - MoveColRow ( pTP.x , pTP.y , True , True ); - fSelST := aBuffer.SelS ; - fSelEN := aBuffer.SelE ; - fSelPO := aBuffer.SelP ; - fModified := aBuffer.Modified; -end; - -function SetUndoPointer ( var aUR : TUndoRec) :Byte; -var - pSK : Integer; -begin - fUndoMem.Position := fUndoMem.Size-4; - fUndoMem.Read ( pSK , 4 ); - fUndoMem.Seek ( -pSK , soFromCurrent ); - fUndoMem.Read ( aUR , SizeOf(TUndoRec) ); - Result := aUR.Typ; -end; - -procedure NextUndo ( aCount : Integer ); -var - aUR : TUndoRec; -begin - fDataSize := -1; - fUndoMem.SetSize ( Max ( 0 , fUndoMem.Size - aCount ) ); - Dec ( fUndoCount ); - if fUndoMem.Size < 5 - then begin - ResetUndo; - end - else begin - fUndoDesc := UndoSTR[(SetUndoPointer ( aUR ) )]; - StateNotification; - end; - -end; - -var - pTY : Byte; - pUR : TUndoRec; -begin - Result := False; - if not fCanUndo - then begin - ResetUndo; - Exit; - end; - if (fUndoMem <> nil) and (fUndoMem.Size > 4 ) - then begin - // letztes word lesen - pTY := SetUndoPointer( pUR); - case pTY of - U_Byte_changed : begin - SetByteAtPos ( pUR.Pos , pUR.Buffer); - SetChanged ( pUR.Pos , pUR.Changed); - SetBuffer ( pUR ); - RedrawPos ( pUR.Pos , pUR.Pos ); - SetInternalBufferByte ( pUR.Pos , pUR.Buffer ); - NextUndo ( SizeOf(TUndoRec)+4); - end; - U_Byte_removed : begin - fIntBufferPos := -1; - InternalInsertBuffer ( Pointer ( Integer (fUndoMem.Memory)+fUndoMem.Position - 1),pUR.Count , pUR.Pos ); - SetBuffer ( pUR ); - if DWORD(fChangedBytes.Size) >= (pUR.Pos ) - then - fChangedBytes.Size := pUR.Pos ; - Invalidate; - NextUndo ( SizeOf(TUndoRec)+4+pUR.Count -1); - end; - U_Insert_buffer : begin - fIntBufferPos := -1; - InternalDeleteSelection ( pUR.Pos , pUR.Pos + pUR.Count , 10 , 0); - SetBuffer ( pUR ); - if DWORD(fChangedBytes.Size) >= (pUR.Pos ) - then - fChangedBytes.Size := pUR.Pos ; - Invalidate; - NextUndo ( SizeOf(TUndoRec)+4); - end; - U_Replace_selection : begin - fIntBufferPos := -1; - InternalDeleteSelection ( pUR.Pos , pUR.Pos + pUR.Count , 10 , 0); - InternalInsertBuffer ( Pointer ( Integer (fUndoMem.Memory)+fUndoMem.Position - 1),pUR.ReplCount , pUR.Pos ); - SetBuffer ( pUR ); - if DWORD(fChangedBytes.Size) >= (pUR.Pos ) - then - fChangedBytes.Size := Max ( 0 , pUR.Pos-1) ; - Invalidate; - NextUndo ( SizeOf(TUndoRec)+4+pUR.ReplCount -1); - end; - U_Append_buffer : begin - fIntBufferPos := -1; - Col := 2; - fIntFile.Size := pUR.Pos; - CalcSizes; - if DWORD(fChangedBytes.Size) >= (pUR.Pos ) - then - fChangedBytes.Size := pUR.Pos ; - SetBuffer ( pUR ); - Invalidate; - NextUndo ( SizeOf(TUndoRec)+4); - end; - U_Nibble_Insert : begin - fIntBufferPos := -1; - InternalDeleteNibble ( pUR.Pos , False ); - SetByteAtPos ( pUR.Pos , pUR.Buffer); - SetChanged ( pUR.Pos , pUR.Changed); - SetBuffer ( pUR ); - if DWORD(fChangedBytes.Size) >= (pUR.Pos ) - then - fChangedBytes.Size := pUR.Pos ; - fIntFile.Size := fIntFile.Size -1; - CalcSizes; - Invalidate; - NextUndo ( SizeOf(TUndoRec)+4); - end; - U_Nibble_Delete : begin - fIntBufferPos := -1; - InternalInsertNibble ( pUR.Pos , False ); - SetByteAtPos ( pUR.Pos , pUR.Buffer); - SetChanged ( pUR.Pos , pUR.Changed); - SetBuffer ( pUR ); - if DWORD(fChangedBytes.Size) >= (pUR.Pos ) - then - fChangedBytes.Size := pUR.Pos ; - fIntFile.Size := fIntFile.Size -1; - CalcSizes; - Invalidate; - NextUndo ( SizeOf(TUndoRec)+4); - end; - U_Convert : begin - fIntBufferPos := -1; - SetMemAtPos ( Pointer ( Integer (fUndoMem.Memory)+fUndoMem.Position - 1),pUR.Pos , pUR.Count ); - SetBuffer ( pUR ); - if DWORD(fChangedBytes.Size) >= (pUR.Pos ) - then - fChangedBytes.Size := pUR.Pos ; - Invalidate; - NextUndo ( SizeOf(TUndoRec)+4+pUR.Count -1); - end; - end; - end - else - ResetUndo; -end; - -procedure THexEditor.SetChanged ( aPos : Integer ; aValue : Boolean ); -begin - if IsInsertMode - then - fChangedBytes.Size := 0; - - if not aValue - then - if fChangedBytes.Size <= aPos - then - Exit; - fChangedBytes[aPos] := aValue; -end; - -{$ifdef _debug} -procedure THexEditor.SaveUndo ( aFileName : TFileName ); -begin - if fUndoMem <> nil - then - fUndoMem.SaveToFile ( aFileName ); -end; -{$endif} - -procedure THexEditor.MoveFileMem ( aFrom , aTo , aCount : Integer ); -var - pBU : PCHar; -begin - GetMem ( pBU , aCount ); - try - fIntFile.Position := aFrom; - fIntFile.Read ( pBU^, aCount ); - fIntFile.Position := aTO; - fIntFile.Write (pBU^, aCount ); - finally - FreeMem ( pBU , aCount ); - end; -end; - -procedure THexEditor.CheckInternalBuffer ( aPos : Integer ); -var - pFR : Integer; -begin - if (fIntBufferPos = -1 ) or (aPos < fIntBufferPos) or ((aPos+FbytesPerLine) > (fIntBufferPos+cBuf_size)) - then begin - fDataSize := -1; - pFR := aPos - (cBuf_size div 2); - if pFR < 0 - then - pFR := 0; - fIntFile.Position := pFR; - fIntFile.Read ( fIntBuffer^, cBuf_Size); - fIntBufferPos := pFR; - end; -end; - -procedure THexEditor.SetInternalBufferByte ( aPos : Integer ; aByte : Byte ); -begin - if (aPos < fIntBufferPos) or ((aPos+FbytesPerLine) > (fIntBufferPos+cBuf_Size)) or (fIntBufferPos = -1 ) - then - Exit; - fIntBuffer[aPos-fIntBufferPos] := aByte; -end; - -function THexEditor.GetCursorPos : Integer; -begin - Result := GetPosAtCursor ( Col , Row ); - if Result < 0 - then - Result := 0; - - if Result > Max ( 0 , DataSize - 1 ) - then - Result := Max ( 0 , DataSize - 1 ) -end; - -function THexEditor.GetSelCount : Integer; -begin - if fSelPO = -1 - then - Result := 0 - else - Result := Max ( fSelST , fSelEN ) - Min ( fSelST , fSelEN ) +1; -end; - -procedure THexEditor.TestStream; -begin - if fIntFile = nil - then begin - DeleteFile ( fInternalName ); - fIntFile := TFileStream.Create ( fInternalName , fmCreate ); - fIntFile.Position := 0; - fChangedBytes.Size := 0; - end; -end; - -function THexEditor.GetMemory ( aIndex : Integer ):Char; -begin - if (aIndex < 0) or (aIndex >= DataSize) - then - Raise Exception.Create ( 'Invalid GetMemory index' ) - else begin - fIntFile.Position := aIndex; - fIntFile.Read ( Result , 1 ); - end; -end; - -procedure THexEditor.SetMemory ( aIndex : Integer ; aChar : Char ); -begin - if (aIndex < 0) or (aIndex >= DataSize) - then - Raise Exception.Create ( 'Invalid SetMemory index' ) - else begin - fIntFile.Position := aIndex; - fIntFile.Write ( aChar , 1 ); - fIntBufferPos := -1; - end; -end; - -procedure THexEditor.SetReadOnlyFile ( const aValue : Boolean ); -begin - if aValue and (not fReadOnlyFile) - then begin - fReadOnlyFile := True; - StateNotification; - end; -end; - -function THexEditor.BufferFromFile ( aPos : Integer ; var aCount : Integer ): PChar; -begin - if (aPos < 0) or (aPos >= DataSize ) - then - raise Exception.Create ( 'Invalid BufferFromFile argument' ) - else begin - if (aPos + aCount) > DataSize - then - aCount := (DataSize-aPos) + 1; - - GetMem ( Result , aCount ); - try - fIntFile.Position := aPos; - fIntFile.Read ( Result^, aCount ); - except - FreeMem ( Result , aCount ); - Result := nil; - aCount := 0; - end; - end; -end; - -procedure THexEditor.WMVScroll(var Msg: TWMVScroll); -var - pRC : TRect; -begin - inherited; - pRC := CellRect ( Col , Row ); - if pRC.Left+pRC.Bottom = 0 - then - SetCaretPos ( -50 , -50) - else - SetCaretPos ( pRC.Left , pRC.Top); -end; - -procedure THexEditor.WMHScroll(var Msg: TWMHScroll); -var - pRC : TRect; -begin - inherited; - pRC := CellRect ( Col , Row ); - if pRC.Left+pRC.Bottom = 0 - then - SetCaretPos ( -50 , -50) - else - SetCaretPos ( pRC.Left , pRC.Top); -end; - -procedure THexEditor.CreateColoredCaret; -begin - DestroyCaret (); - fCaretBitmap.Width := fCharWidth; - fCaretBitmap.Height := fCharHeight-2; - fCaretBitmap.Canvas.Brush.Color := clBlack; - fCaretBitmap.Canvas.FillRect (Rect(0,0,fCharWidth , fCharHeight-2) ); - fCaretBitmap.Canvas.Brush.Color := fColors.CursorFrame xor $00FFFFFF ; - case fCaretStyle - of - csFull : fCaretBitmap.Canvas.FillRect (Rect(0,0,fCharWidth , fCharHeight-2) ); - csLeftLine : fCaretBitmap.Canvas.FillRect (Rect(0,0,2 , fCharHeight-2) ); - csBottomLine : fCaretBitmap.Canvas.FillRect (Rect(0,fCharHeight-4,fCharWidth , fCharHeight-2) ); - end; - CreateCaret ( Handle , fCaretBitmap.Handle , 0,0); -end; - -procedure THexEditor.SetBytesPerColumn(const Value: Integer); -begin - if fBytesPerColumn <> (Value * 2) - then begin - fBytesPerColumn := Value * 2; - AdjustMetrics; - Invalidate; - end; -end; - -function THexEditor.GetBytesPerColumn : Integer; -begin - Result := fBytesPerColumn div 2; -end; - -function THexEditor.Find ( aBuffer : PChar ; const aCount , aStart , aEnd : Integer ; - const IgnoreCase , SearchText : Boolean ) : Integer; - // find something in the current file and return the position, -1 if not found -var - pCR : TCursor; - pChAct : Char; - pCMem , pCFind , pCHit , pEnd : Integer; -begin - Result := -1; - pEnd := aEnd; - if pEnd >= DataSize - then - pEnd := DataSize -1; - - if aCount < 1 - then - Exit; - - if aStart + aCount > (pEnd+1) - then - Exit; // will never be found, if search-part is smaller than searched data - - pCR := Cursor; - Cursor := crHourGlass; - - if SearchText and ( fTranslation <> ttAnsi ) - then - TranslateBufferFromAnsi ( fTranslation , aBuffer , aBuffer , aCount ); - - try - if IgnoreCase - then - CharLowerBuff ( aBuffer , aCount ); - - pCMem := aStart; - PCFind := 0; - pCHit := pCMem+1; - - repeat - {$ifdef _debug} - if (PCMem mod 100000) = 0 - then - TForm(Owner).Caption := IntToStr(PCMem); - {$EndIf} - - if pCMem > pEnd - then - Exit; - - CheckInternalBuffer ( pCMem ); - PChAct := Char(fIntBuffer [ pCMem - fIntBufferPos]); - if IgnoreCase - then - CharLowerBuff ( @PChAct , 1 ); - - if ( PChAct = aBuffer[PCFind] ) - then begin - if PCFind = (aCount-1) - then begin - Result := PCMem-aCount+1; - Exit; - end - else begin - if PCFind = 0 - then - PCHit := PCMem+1; - Inc ( PCMem ); - Inc ( PCFind ); - end; - end - else begin - PCMem := PCHit; - PCFind := 0; - PCHit := PCMem+1; - end; - until False; - - - finally - Cursor := pCR; - end; - -end; - -procedure THexEditor.SetOffsetDisplayWidth; -begin - if fOffsetDisplay = odNone - then - fOffsetDisplayWidth := 0 - else begin - if fOffsetDisplay = odHex - then - fOffsetDisplayWidth := Length(IntToHex ( LineOffset[RowCount - 1] , 1 ))+3 - else - if fOffsetDisplay = odDec - then - fOffSetDisplayWidth := Length(IntToStr ( LineOffset[RowCount - 1]))+1 - else - fOffSetDisplayWidth := Length(IntToOctal ( LineOffset[RowCount - 1]))+3; - end; - ColWidths[0] := fOffsetDisplayWidth * fCharWidth; -end; - -procedure THexEditor.SetShowMarkerColumn( const Value : Boolean ); -begin - if Value <> fShowMarkerCol - then begin - fShowMarkerCol := Value; - AdjustMetrics; - end; -end; - -function THexEditor.Seek (const aOffset , aOrigin : Integer ; const FailIfOutOfRange : Boolean ) : Boolean; -var - pNP : Integer; -begin - Result := False; - pNP := GetCursorPos; - case aOrigin - of - soFromBeginning : pNP := aOffset; - soFromCurrent : pNP := GetCursorPos + aOffset; - soFromEnd : pNP := DataSize + aOffset - 1; - end; - if DataSize < 1 - then - Exit; - - if pNP < 0 - then begin - pNP := 0; - if FailIfOutOfRange - then - Exit; - end; - - if pNP >= DataSize - then begin - pNP := DataSize -1; - if FailIfOutOfRange - then - Exit; - end; - SelStart := pNP; - Result := True; -end; - -procedure THexEditor.SetSwapNibbles ( const Value : Boolean ); -begin - if Integer(Value) <> fSwapNibbles - then begin - fSwapNibbles := Integer(Value); - Invalidate; - end; -end; - -function THexEditor.GetSwapNibbles : Boolean; -begin - Result := Boolean ( fSwapNibbles ); -end; - -procedure THexEditor.SetColors(const Value: TColors); -begin - fColors := Value; -end; - -procedure THexEditor.SetOffsetChar(const Value: Char); -begin - if (FOffsetChar <> Value) then begin - FOffsetChar := Value; - Invalidate; - end; -end; - -procedure THexEditor.SetOffsetDisplay(const Value: TOffsetDisplayStyle); -begin - if FOffsetDisplay <> Value - then begin - FOffsetDisplay := Value; - - SetOffsetDisplayWidth; - - Invalidate; - end; -end; - - -procedure THexEditor.SetCaretStyle(const Value: TCaretStyle); -begin - if FCaretStyle <> Value - then begin - FCaretStyle := Value; - if Focused - then begin - CreateColoredCaret; - SetCaretPos ( -50 , -50 ); - ShowCaret ( Handle ); - Invalidate; - end; - end; -end; - -procedure THexEditor.SetFocusFrame(const Value: Boolean); -begin - if FFocusFrame <> Value then begin - FFocusFrame := Value; - Invalidate; - end; -end; - -procedure THexEditor.SetMaskWhiteSpaces (const aValue : Boolean ); -begin - if FMaskWhiteSpaces <> aValue then begin - FMaskWhiteSpaces := aValue; - Invalidate; - end; -end; - -procedure THexEditor.SetMaskChar ( const aValue : Char ); -begin - if fMaskChar <> aValue then begin - FMaskChar := aValue; - Invalidate; - end; -end; - -procedure THexEditor.SetAsText ( const aValue : string ); -var - lPC : PChar; -begin - if DataSize > 0 - then begin - // alles selektieren - SelStart := 0; - SelEnd := DataSize - 1; - end; - // do translation (thanks to philippe chessa) dec 17 98 - GetMem ( lPC , Length ( aValue )); - try - Move ( aValue[1] , lPC^, Length ( aValue )); - TranslateBufferFromANSI ( fTranslation , @aValue[1] , lPC , Length ( aValue )); - ReplaceSelection ( lPC , Length ( aValue )); - finally - FreeMem ( lPC ); - end; -end; - -procedure THexEditor.SetAsHex ( const aValue : string ); -var - buf : PChar; - lBD : Integer; -begin - if DataSize > 0 - then begin - // alles selektieren - SelStart := 0; - SelEnd := DataSize - 1; - end; - GetMem ( buf , Length ( aValue ) ); - try - ConvertHexToBin ( @aValue[1] , Buf , Length ( aValue ) , SwapNibbles , lBD ); - ReplaceSelection ( buf , lBD ); - finally - FreeMem ( buf ); - end; -end; - -function THexEditor.GetAsText : string; -begin - if DataSize < 1 - then - Result := '' - else begin - SetLength ( Result , DataSize ); - GetMemAtPos ( @Result[1] , 0 , DataSize ); - end; -end; - -function THexEditor.GetAsHex : string; -var - buf : PChar; - lSZ : Integer; -begin - if DataSize < 1 - then - Result := '' - else begin - lSZ := DataSize; - GetMem ( Buf , DataSize ); - try - buf := BufferFromFile ( 0 , lSZ ); - SetLength ( Result , DataSize * 2 ); - ConvertBinToHex ( Buf , @Result[1] , DataSize , SwapNibbles ); - finally - FreeMem ( Buf , DataSize ); - end; - end; -end; - -procedure THexEditor.SetVariableLineLength ( const aValue : Boolean ); -var - ppos : Integer; - pt : TLongPoint; - pss,pse,psp : Integer; -begin - if aValue <> fVariableLineLength - then begin - psp := fSelPO; - pss := fSelST; - pse := fSelEN; - ppos := GetPosAtCursor ( Col , Row ); - fVariableLineLength := aValue; - CalcSizes; - pt := GetCursorAtPos ( pPos , fPosInChars ); - MoveColRow ( pt.x , pt.y , True , True ); - Application.ProcessMessages; - fSelST := pss; - fSelEN := pse; - fSelPO := psp; - Invalidate; - end; -end; - -procedure THexEditor.AdjustLineLengthsCount; -begin - if fOffsets.Count = 0 - then - fOffsets.Add ( Pointer ( 0 )); - - while fOffsets.Count < (RowCount+1) - do - fOffsets.Add ( Pointer ( fBytesPerLine + Integer ( fOffsets[fOffsets.Count-1] ))); -end; - -procedure THexEditor.SetLineLength ( aLine , aLength : Integer ) ; -var - pCT : Integer; - pdf : Integer; -begin - - AdjustLineLengthsCount; - - if (aLength < 1) or (aLength > fBytesPerLine) - then begin - Raise Exception.Create ( 'Invalid Line Length argument' ); - Exit; - end; - - while fOffsets.Count < (aLine+2) - do - fOffsets.Add ( Pointer ( fBytesPerLine + Integer ( fOffsets[fOffsets.Count-1] ))); - - pdf := LineLength[aLine]-aLength; - - if pdf <> 0 - then begin - for pct := fOffsets.Count-1 downto aLine + 1 - do - fOffsets[pct] := Pointer ( Integer ( fOffsets[pct] ) - pdf ); - - if fVariableLineLength - then begin - CalcSizes; - Invalidate; - end; - end; -end; - -function THexEditor.GetLineLength ( aLine : Integer ) : Integer; -begin - if not fVariableLineLength - then - Result := fBytesPerLine - else begin - AdjustLineLengthsCount; - while fOffsets.Count < (aLine+2) - do - fOffsets.Add ( Pointer ( fBytesPerLine + Integer ( fOffsets[fOffsets.Count-1] ))); - - Result := Integer(fOffsets[aLine+1])-Integer ( fOffsets[aLine]); - end; -end; - -function THexEditor.GetLineOffset ( aLine : Integer ) : Integer; -begin - if not fVariableLineLength - then - Result := aLine * fBytesPerLine - else begin - AdjustLineLengthsCount; - while fOffsets.Count < (aLine+2) - do - fOffsets.Add ( Pointer ( fBytesPerLine + Integer ( fOffsets[fOffsets.Count-1] ))); - - Result := Integer(fOffsets[aLine]); - end; -end; - -procedure THexEditor.ClearOffsets; -begin - fOffsets.Clear; -end; - -procedure THexEditor.SetLineLengths ( aLengths : TList ); -var - pCT : Integer; - pPos : Integer; - pSP,pSS,pSE,pPs : Integer; - pTP : TLongPoint; - pInCH : Boolean; -begin - pSP := fSelPO; - pSS := fSelST; - pSE := fSelEN; - pPS := GetPosAtCursor ( Col , Row ); - pInCH := fPosInChars; - fOffsets.Clear; - if aLengths.Count > 0 - then begin - pPos := 0; - for pCT := 0 to aLengths.Count - 1 - do begin - fOffsets.Add ( Pointer ( pPos )); - pPos := pPos + Integer(aLengths[pCT]); - end; - end; - CalcSizes; - pTP := GetCursorAtPos ( pPs , pInCH ); - MoveColRow ( pTP.x , pTP.y , True , True ); - fSelPO := pSP; - fSelST := pSS; - fSelEN := pSE; - Invalidate; -end; - -function THexEditor.GetIsInsertMode: Boolean; -begin - Result := fInsertOn and (not fNoSizeChange) and fAllowInsertMode; -end; - -procedure THexEditor.SetAllowInsertMode(const aValue: Boolean); -begin - if fNoSizeChange - then - fAllowInsertMode := False - else - fAllowInsertMode := aValue; - StateNotification; -end; - - -procedure THexEditor.SetNoSizeChange(const aValue: Boolean); -begin - fNoSizeChange := aValue; - AllowInsertMode := fAllowInsertMode; -end; - -procedure THexEditor.StateNotification; -begin - if HandleAllocated - then - PostMessage ( Handle , WM_STATECHANGED , 7 , 7 ); - -end; - -procedure THexEditor.InternalErase(const BackSp: Boolean); -var - nPos : Integer; -begin - nPos := GetCursorPos; - if BackSp - then begin // Delete previous byte - if nPos = 0 - then - Exit; // Can't delete at offset -1 - if not CreateUndo(U_Byte_removed, nPos - 1, 1, 0) - then - Exit; - InternalDeleteSelection(nPos - 1, nPos, Col, Row); - Seek(nPos - 1, soFromBeginning, true); // Move caret - end - else begin // Delete next byte - if nPos = DataSize - then - Exit; // Cant delete at EOF - if CreateUndo(U_Byte_removed, nPos, 1, 0) - then - InternalDeleteSelection(nPos, nPos + 1, Col, Row); - end; -end; - -procedure THexEditor.SetAutoCaretMode(const aValue: Boolean); -begin - fAutoCaretMode := aValue; - if aValue - then begin - if IsInsertMode - then - CaretStyle := csLeftLine - else - CaretStyle := csFull; - end; -end; - -procedure THexEditor.WMGetDlgCode(var Msg: TWMGetDlgCode); -begin - inherited; - Msg.Result := Msg.Result or DLGC_WANTARROWS or DLGC_WANTCHARS ; - if fWantTabs - then - Msg.Result := Msg.Result or DLGC_WANTTAB - else - Msg.Result := Msg.Result and not DLGC_WANTTAB; -end; - -procedure THexEditor.CMFontChanged(var Message: TMessage); -begin - inherited; - if HandleAllocated - then begin - AdjustMetrics; - if Focused - then begin - CreateColoredCaret; - ShowCaret ( Handle ); - end; - end; -end; - -procedure THexEditor.SetWantTabs(const Value: Boolean); -begin - FWantTabs := Value; -end; - -procedure THexEditor.SetReadOnlyView(const Value: Boolean); -begin - FReadOnlyView := Value; -end; - -{ TColors } - -constructor TColors.Create(Parent: TControl); -begin - inherited Create; - FBackground := clWindow; - FPositionText := clWhite; - FChangedText := clMaroon; - FCursorFrame := clNavy; - FOffset := clBlack; - FOddColumn := clBlue; - FEvenColumn := clNavy; - - FOddInverted := Invert(FOddColumn); - FEvenInverted := Invert(FEvenColumn); - - FChangedBackground := $00A8FFFF; - FPositionBackground := clMaroon; - - FParent := Parent; -end; - -procedure TColors.SetBackground(const Value: TColor); -begin - if FBackground <> Value then - begin - FBackground := Value; - THexEditor(FParent).Color := Value; - FParent.Repaint; - end; -end; - -procedure TColors.SetChangedBackground(const Value: TColor); -begin - if FChangedBackground <> Value then - begin - FChangedBackground := Value; - FParent.Invalidate; - end; -end; - -procedure TColors.SetChangedText(const Value: TColor); -begin - if FChangedText <> Value then - begin - FChangedText := Value; - FParent.Invalidate; - end; -end; - -procedure TColors.SetCursorFrame(const Value: TColor); -begin - if FCursorFrame <> Value then - begin - FCursorFrame := Value; - FParent.Invalidate; - end; -end; - -procedure TColors.SetEvenColumn(const Value: TColor); -begin - if FEvenColumn <> Value then - begin - FEvenColumn := Value; - FEvenInverted := Invert(FEvenColumn); - FParent.Invalidate; - end; -end; - -procedure TColors.SetOddColumn(const Value: TColor); -begin - if FOddColumn <> Value then - begin - FOddColumn := Value; - FOddInverted := Invert(FOddColumn); - FParent.Invalidate; - end; -end; - -procedure TColors.SetOffset(const Value: TColor); -begin - if FOffset <> Value then - begin - FOffset := Value; - FParent.Invalidate; - end; -end; - -procedure TColors.SetPositionBackground(const Value: TColor); -begin - if FPositionBackground <> Value then - begin - FPositionBackground := Value; - FParent.Invalidate; - end; -end; - -procedure TColors.SetPositionText(const Value: TColor); -begin - if FPositionText <> Value then - begin - FPositionText := Value; - FParent.Invalidate; - end; -end; - - -(* THexToCanvas *) - -Constructor THexToCanvas.Create ( aOwner : TComponent ) ; -begin - Inherited Create ( aOwner ); - fHexEditor := nil; - fFont := TFont.Create; - Font.Name := 'Courier'; - Font.Size := 12; - fBpL := 16; - fOffsDy := odHex; - fOffsCr := ':'; - fMemDy := odHex; - fMemCr := ';'; - fCharDy := True; - fCharCr := #0; - fShrink := True; - fStretch := True; - fBpC := 2; - fSwapNibbles := False; - -end; - -Destructor THexToCanvas.Destroy; -begin - fFont.Free; - inherited ; -end; - -procedure THexToCanvas.SetFont ( Value : TFont ); -begin - fFont.Assign ( Value ); -end; - -procedure THexToCanvas.SetHexEditor ( Value : THexEditor ); -begin - fHexEditor := Value; - if Value <> nil - then - Value.FreeNotification ( Self ); -end; - -procedure THexToCanvas.Notification ( aComponent : TComponent ; aOperation : TOperation ) ; -begin - if fHexEditor <> nil - then - if aOperation = opRemove - then - if aComponent = fHexEditor - then - fHexEditor := nil; -end; - -procedure THexToCanvas.GetLayout; // get some properties from the assigned THexEditor -begin - if fHexEditor <> nil - then begin - fFont.Assign(fHexEditor.Font ); - fBpC := fHexEditor.BytesPerColumn; - fOffsCr := fHexEditor.OffsetSeparator; - fOffsDy := fHexEditor.OffsetDisplay; - fBpL := fHexEditor.BytesPerLine; - fMemDy := odHex; - fMemCr := ' '; - fCharDy := True; - fCharCr := #0; - fSwapNibbles := Boolean(fHexEditor.SwapNibbles); - end; -end; - -function THexToCanvas.Draw ( aCanvas : TCanvas ; const aStart , aEnd : Integer ; const TopLine , BottomLine : string ) : Integer; - - function GetOneLine ( aPos , aEnd : Integer ) : string; - - function GetByteHex ( aPos , aEnd : Integer ) : string; - begin - if aPos > aEnd - then - Result := ' ' - else begin - Result := IntToHex ( fHexEditor.GetByteAtPos ( aPos ),2); - if fSwapNibbles and (Length(Result) = 2) - then - Result := Result[2]+Result[1]; - end; - end; - - function GetByteDec ( aPos , aEnd : Integer ) : string; - begin - if aPos > aEnd - then - Result := ' ' - else - Result := FillLeft ( ' ',IntToStr(fHexEditor.GetByteAtPos ( aPos )) , 3); - end; - - function GetByteOctal ( aPos , aEnd : Integer ) : string; - begin - if aPos > aEnd - then - Result := ' ' - else - Result := FillLeft ( '0',IntToOctal(fHexEditor.GetByteAtPos ( aPos )) , 4); - end; - - var - pCT : Integer; - begin - case fOffsDy of - odNone : Result := ''; - odHex : Result := '0x'+IntToHex( aPos , fHexEditor.fOffsetDisplayWidth-3); - odDec : Result := FillLeft(' ',IntToStr( aPos ), fHexEditor.fOffsetDisplayWidth-1); - odOctal: Result := 'o '+FillLeft('0',IntToOctal( aPos ), fHexEditor.fOffsetDisplayWidth-3); - end; - if fOffsCr <> #0 - then - Result := Result + fOffsCr; - - if fMemDy = odHex - then begin - for pct := 1 to fBpL - do begin - Result := Result+GetByteHex ( aPos-1+pct , aEnd ); - if (pct mod fBpC ) = 0 - then - Result := Result+' '; - end; - end - else - if fMemDy = odDec - then begin - for pct := 1 to fBpL - do begin - Result := Result+GetByteDec ( aPos - 1 + pct , aEnd ); - if (pCt mod fBpC ) = 0 - then - Result := Result+' '; - end; - end - else - if fMemDy = odOctal - then begin - for pct := 1 to fBpL - do begin - Result := Result+GetByteOctal ( aPos - 1 + pct , aEnd ); - if (pCt mod fBpC ) = 0 - then - Result := Result+' '; - end; - end; - if fMemCr <> #0 - then - Result := Result+ fMemCr; - - if fCharDy - then - for pct := 1 to fBpL - do - if (aPos+pCt-1) > aEnd - then - Result := Result+' ' - else - Result := Result + fHexEditor.TranslateToAnsiChar ( fHexEditor.GetByteAtPos ( aPos+pCt-1 ) ); - if fCharCr <> #0 - then - Result := Result+ fCharCr; - end; - - -var - tmpFont : TFont; - OneLine : string; - lLen,lHe,lPos,lup,pEnd : Integer; -begin - - Result := -1; - if fBpL < 1 - then - Exit; - - if fHexEditor = nil - then begin - Result := MaxInt; - Exit; - end; - - pEnd := aEnd; - - if pEnd >= fHexEditor.DataSize - then - pEnd := fHexEditor.DataSize -1; - - if aStart > pEnd - then - Exit; - - // länge einer zeile berechnen - OneLine := GetOneLine ( aStart , pEnd ); - tmpFont := TFont.Create; - try - tmpFont.Assign ( aCanvas.Font ); - aCanvas.Font.Assign ( fFont ); - - if fStretch - then begin - lLen := aCanvas.TextWidth ( OneLine ); - while lLen < (fRightM - fLeftM) - do begin - aCanvas.Font.Size := aCanvas.Font.Size + 1; - lLen := aCanvas.TextWidth ( OneLine ); - end; - while lLen > (fRightM - fLeftM) - do begin - aCanvas.Font.Size := aCanvas.Font.Size - 1; - lLen := aCanvas.TextWidth ( OneLine ); - end; - end; - - if fShrink - then begin - lLen := aCanvas.TextWidth ( OneLine ); - while lLen > (fRightM - fLeftM) - do begin - aCanvas.Font.Size := aCanvas.Font.Size - 1; - lLen := aCanvas.TextWidth ( OneLine ); - end; - end; - - - lHe := Round(aCanvas.TextHeight ( OneLine ) * 1.2); - if lHe = aCanvas.TextHeight ( OneLine ) - then - inc ( lHe ); - - lPos := aStart; - lUp := fTopM; - if TopLine <> '' - then begin - aCanvas.TextOut ( fLeftM , lUp , TopLine ); - lUp := lUp+lHe; - end; - - if BottomLine <> '' - then - fBottomM := fBottomM - lHe; - - while (lHe + lUp ) <= fBottomM - do begin - aCanvas.TextOut ( fLeftM , lUp , OneLine ); - lPos := lPos+fBpL; - if lPos > pEnd - then begin - lPos := pEnd + 1; - Break; - end; - OneLine := GetOneLine ( lPos , pEnd ); - lUp := lUp + lHe; - end; - Result := lPos; - - if BottomLine <> '' - then - aCanvas.TextOut ( fLeftM , fBottomM , BottomLine ); - - finally - aCanvas.Font.Assign ( tmpFont ); - tmpFont.Free; - end; - -end; - -end. - - diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/md5unit.pas b/sdk/components/ElPack/BCBDemos/ElKeeper/md5unit.pas deleted file mode 100644 index c1d513229b3..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/md5unit.pas +++ /dev/null @@ -1,498 +0,0 @@ -unit Md5unit; -{***************************************************************************** - UNIT: MD5Unit - Description: This unit contains an Object Pascal Object which can be used to - perform an MD5 Hashing of byte array, file, or Pascal String. An - MD5 Hashing or Message Digest is a 'finger print' of the - input. This is 100% PASCAL!!! - - "It is conjectured that it is computationally infeasible - to produce two messages having the same message digest".... - "The MD5 algorithm is intended for digital signature - applications, where a large file must be "compressed" in a - secure manner before being encrypted with a private (secret) key - under a public-key cryptosystem such as RSA." R. Rivest - RfC: 1321, RSA Data Security, Inc. April 1992 - - The MD5 Algorithm was produced by RSA Data Security Inc.(See LEGAL) - ----------------------------------------------------------------------------- - Code Author: Greg Carter, gregc@cryptocard.com - Organization: CRYPTOCard Corporation, info@cryptocard.com - R&D Division, Carleton Place, ON, CANADA, K7C 3T2 - 1-613-253-3152 Voice, 1-613-253-4685 Fax. - Date of V.1: Jan. 3 1996. - - Compatibility & Testing with BP7.0: Anne Marcel Roorda, garfield@xs4all.nl - -----------------------------------------------------------------------------} - {Useage: Below is typical usage(for File)of the MD5 Object, Follow these steps: - Step 1: Declare and Create a New TMD5 object. This can be done by - 'Drag N Drop' a TMD5 off the Delphi Tool Pallet, - or explicitly in code. - Step 2: Set the InputType. - Step 3: Point to the input(InputString, InputFilePath, pInputArray). - Step 4: Point to the output Array(pOutputArray). - Step 5: Call the MD5_Hash procedure. - Your Done! - -Example -procedure Tcryptfrm.Button1Click(Sender: TObject); -var - md5hash: TMD5; (* Step 1a *) - outarray: array[0..15] of char; - InputFile: File; - startTime: LongInt; -begin - md5hash := TMD5.Create(Self); (* Step 1b *) - try - If OpenDialog1.Execute then - begin - md5hash.InputType := SourceFile; (* Step 2 *) - md5hash.InputFilePath := OpenDialog1.FileName; (* Step 3 *) - md5hash.pOutputArray := @outarray; (* Step 4 *) - startTime := timeGetTime; - md5hash.MD5_Hash; (* Step 5 *) - LEDLabel1.Caption := IntToStr(timeGetTime - startTime); - Label2.Caption := StrPas(outarray); (* Do something with output *) - end;(* if *) - finally - md5hash.free; - end; -end; -{-----------------------------------------------------------------------------} -{LEGAL: The algorithm was placed into the public domain, hence requires - no license or runtime fees. However this code is copyright by - CRYPTOCard. CRYPTOCard grants anyone who may wish to use, modify - or redistribute this code privileges to do so, provided the user - agrees to the following three(3) rules: - - 1)Any Applications, (ie exes which make use of this - Object...), for-profit or non-profit, - must acknowledge the author of this Object(ie. - MD5 Implementation provided by Greg Carter, CRYPTOCard - Corporation) somewhere in the accompanying Application - documentation(ie AboutBox, HelpFile, readme...). NO runtime - or licensing fees are required! - - 2)Any Developer Component(ie Delphi Component, Visual Basic VBX, - DLL) derived from this software must acknowledge that it is - derived from "MD5 Object Pascal Implementation Originated by - Greg Carter, CRYPTOCard Corporation 1996". Also all efforts should - be made to point out any changes from the original. - !!!!!Further, any Developer Components based on this code - *MAY NOT* be sold for profit. This Object was placed into the - public domain, and therefore any derived components should - also.!!!!! - - 3)CRYPTOCard Corporation makes no representations concerning this - software or the suitability of this software for any particular - purpose. It is provided "as is" without express or implied - warranty of any kind. CRYPTOCard accepts no liability from any - loss or damage as a result of using this software. - -CRYPTOCard Corporation is in no way affiliated with RSA Data Security Inc. -The MD5 Algorithm was produced by RSA Data Security Inc. ------------------------------------------------------------------------------ -Why Use this instead of a freely available C DLL? - -The goal was to provide a number of Encryption/Hash implementations in Object -Pascal, so that the Pascal Developer has considerably more freedom. These -Implementations are geared toward the PC(Intel) Microsoft Windows developer, -who will be using Borland's New 32bit developement environment(Delphi32). The -code generated by this new compiler is considerablely faster then 16bit versions. -And should provide the Developer with faster implementations then those using -C DLLs. ------------------------------------------------------------------------------ -NOTES: Version 1 does not contain any cross-platform considerations. If trying - to use this code on a Big Endian style processor you will need to write - additional code to reorder the bytes. ------------------------------------------------------------------------------- -Revised: 00/00/00 BY: ******* Reason: ****** ------------------------------------------------------------------------------- -} -{Declare the compiler defines} -{------Changeable compiler switches-----------------------------------} -{$A+ Word align variables } -{$F+ Force Far calls } -{$K+ Use smart callbacks -{$N+ Allow coprocessor instructions } -{$P+ Open parameters enabled } -{$S+ Stack checking } -{$T- @ operator is NOT typed } -{$U- Non Pentium safe FDIV } -{$Z- No automatic word-sized enumerations} -{$H+ Huge Strings} -{$Q- No Integer overflow checking} -{---------------------------------------------------------------------} - -interface -uses SysUtils, Classes, Windows -{$IFNDEF MD5ONLY} -, CryptCon -{$ENDIF} -; - - {An enumerated typt which tells the object what type the input to the cipher is} -{$IFDEF MD5ONLY} -type - TSourceType = (SourceFile, SourceByteArray,SourceString); -{$ENDIF} - -Type -ULONG32 = record - LoWord16: WORD; - HiWord16: WORD; -end; - -PULONG32 = ^ULONG32; -PLong = ^LongInt; - -hashDigest = record - A: DWORD; - B: DWORD; - C: DWORD; - D: DWORD; -end;{hashArray} - -PTR_Hash = ^hashDigest; - - TMD5 = class - Private - { Private declarations } - - FType : TSourceType; {Source type, whether its a file or ByteArray, or - a Pascal String} - FInputFilePath: String; {Full Path to Input File} - FInputArray: PByte; {Point to input array} - FInputString: String; {Input String} - FOutputDigest: PTR_Hash; {output MD5 Digest} - FSourceLength: LongInt; {input length in BYTES} - FActiveBlock: Array[0..15] of DWORD; {the 64Byte block being transformed} - FA, FB, FC, FD, FAA, FBB, FCC, FDD: DWORD; - {FA..FDD are used during Step 4, the transform. I made them part of the - Object to cut down on time used to pass variables.} - {FF, GG, HH, II are used in Step 4, the transform} - Procedure FF(var a, b, c, d, x: DWORD; s: BYTE; ac: DWORD); - Procedure GG(var a, b, c, d, x: DWORD; s: BYTE; ac: DWORD); - Procedure HH(var a, b, c, d, x: DWORD; s: BYTE; ac: DWORD); - Procedure II(var a, b, c, d, x: DWORD; s: BYTE; ac: DWORD); - - protected - { Protected declarations } - public - { Public declarations } - {Initialize is used in Step 3, this fills FA..FD with init. values - and points FpA..FpD to FA..FD} - Procedure MD5_Initialize; - {this is where all the magic happens} - Procedure MD5_Transform; - Procedure MD5_Finish; - Procedure MD5_Hash_Bytes; -{ Procedure MD5_Hash_String;(Pascal Style strings???)} - Procedure MD5_Hash_File; - {This procedure sends the data 64Bytes at a time to MD5_Transform} - Procedure MD5_Hash; - Property pInputArray: PByte read FInputArray write FInputArray; - Property pOutputArray: PTR_Hash read FOutputDigest write FOutputDigest;{!!See FOutputArray} - Published - Property InputType: TSourceType read FType write FType; - Property InputFilePath: String read FInputFilePath write FInputFilePath; - Property InputString: String read FInputString write FInputString; - Property InputLength: LongInt read FSourceLength write FSourceLength; -end;{TMD5} - -Const -{Constants for MD5Transform routine.} - S11 = 7; - S12 = 12; - S13 = 17; - S14 = 22; - S21 = 5; - S22 = 9; - S23 = 14; - S24 = 20; - S31 = 4; - S32 = 11; - S33 = 16; - S34 = 23; - S41 = 6; - S42 = 10; - S43 = 15; - S44 = 21; - -implementation - -{This will only work on an intel} - -{$warnings off} -Function ROL(A: Longint; Amount: BYTE): Longint; -begin - asm - mov cl, Amount - mov eax, a - rol eax, cl - mov result, eax - end; -end; -{$warnings on} - -Procedure TMD5.MD5_Initialize; -begin - FA := $67452301; FB:=$efcdab89; FC:=$98badcfe; FD:=$10325476; -end;{MD5_Initialize} - -Procedure TMD5.FF; -{Purpose: Round 1 of the Transform. - Equivalent to a = b + ((a + F(b,c,d) + x + ac) <<< s) - Where F(b,c,d) = b And c Or Not(b) And d -} -begin - a := a + ((b and c) Or (not(b) And (d))) + x + ac; - a:= ROL(a, s); - Inc(a, b); -end;{FF} - -Procedure TMD5.GG; -{Purpose: Round 2 of the Transform. - Equivalent to a = b + ((a + G(b,c,d) + x + ac) <<< s) - Where G(b,c,d) = b And d Or c Not d -} -begin - a := a + ((b And d) Or ( c And (Not d))) + x + ac; - a:= ROL(a, s); - Inc(a, b); -end;{GG} - -Procedure TMD5.HH; -{Purpose: Round 3 of the Transform. - Equivalent to a = b + ((a + H(b,c,d) + x + ac) <<< s) - Where H(b,c,d) = b Xor c Xor d -} -begin - a := a + (b Xor c Xor d) + x + ac; - a := ROL(a, s); - a := b + a; -end;{HH} - -Procedure TMD5.II; -{Purpose: Round 4 of the Transform. - Equivalent to a = b + ((a + I(b,c,d) + x + ac) <<< s) - Where I(b,c,d) = C Xor (b Or Not(d)) -} -begin - a := a + (c Xor (b Or (Not d))) + x + ac; - a := ROL(a, s); - a := b + a; -end;{II} - -Procedure TMD5.MD5_Transform; -{Purpose: Perform Step 4 of the algorithm. This is where all the important - stuff happens. This performs the rounds on a 64Byte Block. This - procedure should be called in a loop until all input data has been - transformed. -} - -begin - FAA := FA; - FBB := FB; - FCC := FC; - FDD := FD; - - { Round 1 } - FF (FA, FB, FC, FD, FActiveBlock[ 0], S11, $d76aa478); { 1 } - FF (FD, FA, FB, FC, FActiveBlock[ 1], S12, $e8c7b756); { 2 } - FF (FC, FD, FA, FB, FActiveBlock[ 2], S13, $242070db); { 3 } - FF (FB, FC, FD, FA, FActiveBlock[ 3], S14, $c1bdceee); { 4 } - FF (FA, FB, FC, FD, FActiveBlock[ 4], S11, $f57c0faf); { 5 } - FF (FD, FA, FB, FC, FActiveBlock[ 5], S12, $4787c62a); { 6 } - FF (FC, FD, FA, FB, FActiveBlock[ 6], S13, $a8304613); { 7 } - FF (FB, FC, FD, FA, FActiveBlock[ 7], S14, $fd469501); { 8 } - FF (FA, FB, FC, FD, FActiveBlock[ 8], S11, $698098d8); { 9 } - FF (FD, FA, FB, FC, FActiveBlock[ 9], S12, $8b44f7af); { 10 } - FF (FC, FD, FA, FB, FActiveBlock[10], S13, $ffff5bb1); { 11 } - FF (FB, FC, FD, FA, FActiveBlock[11], S14, $895cd7be); { 12 } - FF (FA, FB, FC, FD, FActiveBlock[12], S11, $6b901122); { 13 } - FF (FD, FA, FB, FC, FActiveBlock[13], S12, $fd987193); { 14 } - FF (FC, FD, FA, FB, FActiveBlock[14], S13, $a679438e); { 15 } - FF (FB, FC, FD, FA, FActiveBlock[15], S14, $49b40821); { 16 } - - { Round 2 } - GG (FA, FB, FC, FD, FActiveBlock[ 1], S21, $f61e2562); { 17 } - GG (FD, FA, FB, FC, FActiveBlock[ 6], S22, $c040b340); { 18 } - GG (FC, FD, FA, FB, FActiveBlock[11], S23, $265e5a51); { 19 } - GG (FB, FC, FD, FA, FActiveBlock[ 0], S24, $e9b6c7aa); { 20 } - GG (FA, FB, FC, FD, FActiveBlock[ 5], S21, $d62f105d); { 21 } - GG (FD, FA, FB, FC, FActiveBlock[10], S22, $2441453); { 22 } - GG (FC, FD, FA, FB, FActiveBlock[15], S23, $d8a1e681); { 23 } - GG (FB, FC, FD, FA, FActiveBlock[ 4], S24, $e7d3fbc8); { 24 } - GG (FA, FB, FC, FD, FActiveBlock[ 9], S21, $21e1cde6); { 25 } - GG (FD, FA, FB, FC, FActiveBlock[14], S22, $c33707d6); { 26 } - GG (FC, FD, FA, FB, FActiveBlock[ 3], S23, $f4d50d87); { 27 } - GG (FB, FC, FD, FA, FActiveBlock[ 8], S24, $455a14ed); { 28 } - GG (FA, FB, FC, FD, FActiveBlock[13], S21, $a9e3e905); { 29 } - GG (FD, FA, FB, FC, FActiveBlock[ 2], S22, $fcefa3f8); { 30 } - GG (FC, FD, FA, FB, FActiveBlock[ 7], S23, $676f02d9); { 31 } - GG (FB, FC, FD, FA, FActiveBlock[12], S24, $8d2a4c8a); { 32 } - - { Round 3 } - HH (FA, FB, FC, FD, FActiveBlock[ 5], S31, $fffa3942); { 33 } - HH (FD, FA, FB, FC, FActiveBlock[ 8], S32, $8771f681); { 34 } - HH (FC, FD, FA, FB, FActiveBlock[11], S33, $6d9d6122); { 35 } - HH (FB, FC, FD, FA, FActiveBlock[14], S34, $fde5380c); { 36 } - HH (FA, FB, FC, FD, FActiveBlock[ 1], S31, $a4beea44); { 37 } - HH (FD, FA, FB, FC, FActiveBlock[ 4], S32, $4bdecfa9); { 38 } - HH (FC, FD, FA, FB, FActiveBlock[ 7], S33, $f6bb4b60); { 39 } - HH (FB, FC, FD, FA, FActiveBlock[10], S34, $bebfbc70); { 40 } - HH (FA, FB, FC, FD, FActiveBlock[13], S31, $289b7ec6); { 41 } - HH (FD, FA, FB, FC, FActiveBlock[ 0], S32, $eaa127fa); { 42 } - HH (FC, FD, FA, FB, FActiveBlock[ 3], S33, $d4ef3085); { 43 } - HH (FB, FC, FD, FA, FActiveBlock[ 6], S34, $4881d05); { 44 } - HH (FA, FB, FC, FD, FActiveBlock[ 9], S31, $d9d4d039); { 45 } - HH (FD, FA, FB, FC, FActiveBlock[12], S32, $e6db99e5); { 46 } - HH (FC, FD, FA, FB, FActiveBlock[15], S33, $1fa27cf8); { 47 } - HH (FB, FC, FD, FA, FActiveBlock[ 2], S34, $c4ac5665); { 48 } - - { Round 4 } - II (FA, FB, FC, FD, FActiveBlock[ 0], S41, $f4292244); { 49 } - II (FD, FA, FB, FC, FActiveBlock[ 7], S42, $432aff97); { 50 } - II (FC, FD, FA, FB, FActiveBlock[14], S43, $ab9423a7); { 51 } - II (FB, FC, FD, FA, FActiveBlock[ 5], S44, $fc93a039); { 52 } - II (FA, FB, FC, FD, FActiveBlock[12], S41, $655b59c3); { 53 } - II (FD, FA, FB, FC, FActiveBlock[ 3], S42, $8f0ccc92); { 54 } - II (FC, FD, FA, FB, FActiveBlock[10], S43, $ffeff47d); { 55 } - II (FB, FC, FD, FA, FActiveBlock[ 1], S44, $85845dd1); { 56 } - II (FA, FB, FC, FD, FActiveBlock[ 8], S41, $6fa87e4f); { 57 } - II (FD, FA, FB, FC, FActiveBlock[15], S42, $fe2ce6e0); { 58 } - II (FC, FD, FA, FB, FActiveBlock[ 6], S43, $a3014314); { 59 } - II (FB, FC, FD, FA, FActiveBlock[13], S44, $4e0811a1); { 60 } - II (FA, FB, FC, FD, FActiveBlock[ 4], S41, $f7537e82); { 61 } - II (FD, FA, FB, FC, FActiveBlock[11], S42, $bd3af235); { 62 } - II (FC, FD, FA, FB, FActiveBlock[ 2], S43, $2ad7d2bb); { 63 } - II (FB, FC, FD, FA, FActiveBlock[ 9], S44, $eb86d391); { 64 } - - Inc(FA, FAA); - Inc(FB, FBB); - Inc(FC, FCC); - Inc(FD, FDD); - { Zeroize sensitive information} - FillChar(FActiveBlock, SizeOf(FActiveBlock), #0); -end;{TMD5.MD5_Transform} - -Procedure TMD5.MD5_Hash; -var - pStr: PChar; -begin - MD5_Initialize; - case FType of - SourceFile: - begin - MD5_Hash_File; - end;{SourceFile} - SourceByteArray: - begin - MD5_Hash_Bytes; - end;{SourceByteArray} - SourceString: - begin - {Convert Pascal String to Byte Array} - pStr:=nil; - try {protect dyanmic memory allocation} - GetMem(pStr, Length(FInputString)+1); - StrPCopy(pStr, FInputString); - FSourceLength := Length(FInputString); - FInputArray := Pointer(pStr); - MD5_Hash_Bytes; - finally - if pStr<>nil then FreeMem(pStr, Length(FInputString)+1); - end; - end;{SourceString} - end;{case} - MD5_Finish; -end;{TMD5.MD5_Hash} - -Procedure TMD5.MD5_Hash_Bytes; -var - Buffer: array[0..4159] of Byte; - Count64: Comp; - index: longInt; -begin - Move(FInputArray^, Buffer, FSourceLength); - Count64 := FSourceLength * 8; {Save the Length(in bits) before padding} - Buffer[FSourceLength] := $80; {Must always pad with at least a '1'} - inc(FSourceLength); - - while (FSourceLength mod 64)<>56 do begin - Buffer[FSourceLength] := 0; - Inc(FSourceLength); - end; - Move(Count64,Buffer[FSourceLength],SizeOf(Count64){This better be 64bits}); - index := 0; - Inc(FSourceLength, 8); - repeat - MoveMemory(@FActiveBlock,@Buffer[Index],64); - MD5_Transform; - Inc(Index,64); - until Index = FSourceLength; -end;{TMD5.Hash_Bytes} - -Procedure TMD5.MD5_Hash_File; -var - Buffer:array[0..4159] of BYTE; - InputFile: File; - Count64: Comp; - DoneFile : Boolean; - Index: LongInt; - NumRead: integer; -begin -DoneFile := False; -{$IFDEF DELPHI} - AssignFile(InputFile, FInputFilePath); -{$ENDIF} -{$IFDEF BP7} - Assign(InputFile, FInputFilePath); -{$ENDIF} - -Reset(InputFile, 1); -Count64 := 0; -repeat - BlockRead(InputFile,Buffer,4096,NumRead); - Count64 := Count64 + NumRead; - if NumRead<>4096 {reached end of file} - then begin - Buffer[NumRead]:= $80; - Inc(NumRead); - while (NumRead mod 64)<>56 - do begin - Buffer[ NumRead ] := 0; - Inc(NumRead); - end; - Count64 := Count64 * 8; - Move(Count64,Buffer[NumRead],8); - Inc(NumRead,8); - DoneFile := True; - end; - Index := 0; - repeat - Move(Buffer[Index], FActiveBlock, 64); - {Flip bytes here on a Mac(I think)} - - MD5_Transform; - Inc(Index,64); - until Index = NumRead; - until DoneFile; -{$IFDEF DELPHI} - CloseFile(InputFile); -{$ENDIF} -{$IFDEF BP7} - Close(InputFile); -{$ENDIF} -end;{TMD5.MD5_Hash_File} - - -Procedure TMD5.MD5_Finish; -begin - FOutputDigest^.A := FA; - FOutputDigest^.B := FB; - FOutputDigest^.C := FC; - FOutputDigest^.D := FD; -end; -end. diff --git a/sdk/components/ElPack/BCBDemos/ElKeeper/readme.txt b/sdk/components/ElPack/BCBDemos/ElKeeper/readme.txt deleted file mode 100644 index eda804e6f6b..00000000000 --- a/sdk/components/ElPack/BCBDemos/ElKeeper/readme.txt +++ /dev/null @@ -1,10 +0,0 @@ -EldoS Keeper source code. - -EldoS Keeper is built using exactly this code. -Note, that if you get an Access Violation, this doesn't mean, that there is a -problem with some code. This can happen because of the compiler options. - -This demo uses freeware third-party component named HexEditor. - -This code can be compiled only with C++Builder 4 or 5. C++Builder 3 can't be -used. diff --git a/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.bpr b/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.bpr deleted file mode 100644 index 5818495068a..00000000000 --- a/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.bpr +++ /dev/null @@ -1,161 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = GridDemo.exe -OBJFILES = Main.obj GridDemo.obj -RESFILES = GridDemo.res -DEFFILE = -RESDEPEN = $(RESFILES) Main.dfm -LIBFILES = -LIBRARIES = -SPARELIBS = VCL35.lib elpackB3.lib -PACKAGES = vclx35.bpi VCL35.bpi vcldb35.bpi vcldbx35.bpi bcbsmp35.bpi dclocx35.bpi \ - Qrpt35.bpi teeui35.bpi VclSmp35.bpi teedb35.bpi tee35.bpi ibsmp35.bpi dss35.bpi \ - NMFast35.bpi inetdb35.bpi inet35.bpi VclMid35.bpi elpackB3.bpi -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -Od -Hc -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U..\..\lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -$Y -$W -$O- -v -JPHN \ - -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /d_RTLDLL /dUSEPACKAGES /mx /w2 /zd -LFLAGS = -L..\..\lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) -aa -Tpe -x -Gn -v -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj $(PACKAGES) sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.cpp b/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.cpp deleted file mode 100644 index f04dcd09db7..00000000000 --- a/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.cpp +++ /dev/null @@ -1,22 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("GridDemo.res"); -USEFORMNS("Main.pas", Main, Form1); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->Title = "Grid Demo"; - Application->CreateForm(__classid(TForm1), &Form1); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.res b/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.res deleted file mode 100644 index b369156c076..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/GridDemo/GridDemo.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/GridDemo/Main.dfm b/sdk/components/ElPack/BCBDemos/GridDemo/Main.dfm deleted file mode 100644 index 210c08accbc..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/GridDemo/Main.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/GridDemo/Main.pas b/sdk/components/ElPack/BCBDemos/GridDemo/Main.pas deleted file mode 100644 index 2dbc6275314..00000000000 --- a/sdk/components/ElPack/BCBDemos/GridDemo/Main.pas +++ /dev/null @@ -1,176 +0,0 @@ -unit Main; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ElTree, ExtCtrls, StdCtrls; - -type - TForm1 = class(TForm) - Tree: TElTree; - ElPanel1: TPanel; - QuickEditCheckBox: TCheckBox; - procedure TreeKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure TreeClick(Sender: TObject); - procedure TreeDblClick(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - Form1: TForm1; - -implementation - -{$R *.DFM} - -procedure TForm1.TreeKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); -var i : integer; - Item : TElTreeItem; -begin - if (Shift = []) then - begin - if (Tree.ItemFocused <> nil) then - begin - if Key = VK_UP then - begin - if QuickEditCheckBox.Checked and Tree.IsEditing then - Tree.EndEdit(true); - - i := Tree.ItemFocused.AbsoluteIndex; - if i > 0 then - begin - Tree.ItemFocused := Tree.Items[i - 1]; - Tree.EnsureVisible(Tree.ItemFocused); - end; - - if QuickEditCheckBox.Checked then - Tree.EditItem(Tree.ItemFocused, Tree.SelectColumn); - Key := 0; - end - else - if Key = VK_DOWN then - begin - if QuickEditCheckBox.Checked and Tree.IsEditing then - Tree.EndEdit(true); - - i := Tree.ItemFocused.AbsoluteIndex; - if i < Tree.Items.Count - 1 then - begin - Tree.ItemFocused := Tree.Items[i + 1]; - Tree.EnsureVisible(Tree.ItemFocused); - end; - - if QuickEditCheckBox.Checked then - Tree.EditItem(Tree.ItemFocused, Tree.SelectColumn); - Key := 0; - end - else - if Key = VK_LEFT then - begin - if QuickEditCheckBox.Checked and Tree.IsEditing then - Tree.EndEdit(true); - if Tree.SelectColumn = 1 then - Tree.SelectColumn := 0 - else - begin - - i := Tree.ItemFocused.AbsoluteIndex; - if i > 0 then - begin - Tree.ItemFocused := Tree.Items[i - 1]; - Tree.EnsureVisible(Tree.ItemFocused); - end; - Tree.SelectColumn := 1; - end; - if QuickEditCheckBox.Checked then - Tree.EditItem(Tree.ItemFocused, Tree.SelectColumn); - Key := 0; - end - else - if Key = VK_RIGHT then - begin - if Tree.SelectColumn = 0 then - Tree.SelectColumn := 1 - else - begin - i := Tree.ItemFocused.AbsoluteIndex; - if i < Tree.Items.Count - 1 then - begin - Tree.ItemFocused := Tree.Items[i + 1]; - Tree.EnsureVisibleBottom(Tree.ItemFocused); - end; - Tree.SelectColumn := 0; - end; - if QuickEditCheckBox.Checked then - Tree.EditItem(Tree.ItemFocused, Tree.SelectColumn); - Key := 0; - end - end; - if Key = VK_INSERT then - begin - Item := Tree.Items.AddItem(nil); - Tree.EnsureVisibleBottom(Item); - if Tree.ItemFocused = nil then - begin - Tree.ItemFocused := Item; - if QuickEditCheckBox.Checked then - Tree.EditItem(Item, Tree.SelectColumn); - end; - Key := 0; - end - else - if Key = VK_DELETE then - begin - Tree.Items.DeleteItem(Tree.ItemFocused); - Key := 0; - end; - end; -end; - -procedure TForm1.TreeClick(Sender: TObject); -var Item : TElTreeItem; - HCol : integer; - IP : TSTItemPart; - P : TPoint; -begin - GetCursorPos(P); - P := Tree.ScreenToClient(P); - Item := Tree.GetItemAt(P.X, P.Y, IP, HCol); - if (Item <> nil) and ((HCol = 0) or (HCol = 1)) then - begin - if QuickEditCheckBox.Checked and Tree.IsEditing then - Tree.EndEdit(true); - Tree.ItemFocused := Item; - Tree.SelectColumn := HCol; - if QuickEditCheckBox.Checked then - Tree.EditItem(Tree.ItemFocused, Tree.SelectColumn); - end; -end; - -procedure TForm1.TreeDblClick(Sender: TObject); -var Item : TElTreeItem; - HCol : integer; - IP : TSTItemPart; - P : TPoint; -begin - GetCursorPos(P); - P := Tree.ScreenToClient(P); - Item := Tree.GetItemAt(P.X, P.Y, IP, HCol); - if (Item <> nil) and ((HCol = 0) or (HCol = 1)) then - begin - if QuickEditCheckBox.Checked and Tree.IsEditing then - Tree.EndEdit(true); - Tree.ItemFocused := Item; - Tree.SelectColumn := HCol; - Tree.EditItem(Tree.ItemFocused, Tree.SelectColumn); - end; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/ElIniEdit.res b/sdk/components/ElPack/BCBDemos/IniEdit/ElIniEdit.res deleted file mode 100644 index 9729e87353d..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/IniEdit/ElIniEdit.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/INITIPS.RES b/sdk/components/ElPack/BCBDemos/IniEdit/INITIPS.RES deleted file mode 100644 index 92ea0a1d0d5..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/IniEdit/INITIPS.RES and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.bpr b/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.bpr deleted file mode 100644 index daa26382f05..00000000000 --- a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.bpr +++ /dev/null @@ -1,159 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = IniEdit.exe -OBJFILES = IniOpts.obj IniStrings.obj Main.obj IniEdit.obj -RESFILES = IniEdit.res -DEFFILE = -RESDEPEN = $(RESFILES) -LIBFILES = -LIBRARIES = -SPARELIBS = VCL35.lib -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -Od -Hc -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -$Y -$W -$O- -v -JPHN \ - -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /d_RTLDLL /dUSEPACKAGES /mx /w2 /zd -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) -aa -Tpe -x -Gn -v -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj $(PACKAGES) sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- - diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.cpp b/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.cpp deleted file mode 100644 index 25f6096e004..00000000000 --- a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.cpp +++ /dev/null @@ -1,23 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("IniEdit.res"); -USEUNIT("IniOpts.pas"); -USEUNIT("IniStrings.pas"); -USEUNIT("Main.pas"); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- - diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.res b/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.res deleted file mode 100644 index 7e24c6942be..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdit.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdits.res b/sdk/components/ElPack/BCBDemos/IniEdit/IniEdits.res deleted file mode 100644 index 5424310a6d0..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/IniEdit/IniEdits.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/IniOpts.pas b/sdk/components/ElPack/BCBDemos/IniEdit/IniOpts.pas deleted file mode 100644 index 55798e9c362..00000000000 --- a/sdk/components/ElPack/BCBDemos/IniEdit/IniOpts.pas +++ /dev/null @@ -1,140 +0,0 @@ -unit IniOpts; - -interface - -uses - Classes, - SysUtils, - ElHeader, - ElTree, - ElOpts; - -type - TOptions = class(TElOptions) - private - FSort: Boolean; - FOneInstance: Boolean; - FCustomColors: Boolean; - FLazyWrite: Boolean; - FSimple: Boolean; - FLoadLastUsed: Boolean; - FShowDailyTip : Boolean; - procedure SetLazyWrite(newValue: Boolean); - procedure SetSimple(newValue: Boolean); - procedure SetCustomColors(newValue: Boolean); - procedure SetOneInstance(newValue: Boolean); - procedure SetSort(newValue: Boolean); - protected - procedure SetAutoSave (value : boolean); override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - published - property LoadLastUsed: Boolean read FLoadLastUsed write FLoadLastUsed; - property LazyWrite: Boolean read FLazyWrite write SetLazyWrite default true; - property Simple: Boolean read FSimple write SetSimple; - property CustomColors: Boolean read FCustomColors write SetCustomColors; - property OneInstance: Boolean read FOneInstance write SetOneInstance; - property Sort: Boolean read FSort write SetSort; - property ShowDailyTip : Boolean read FShowDailyTip write FShowDailyTip; - end; - -var Options : TOptions; - -implementation - -uses Main; - -procedure TOptions.SetAutoSave (value : boolean); -begin - if FAutoSave <> value then - begin - FAutoSave := value; - MainForm.AutoSaveItem.Checked := value; - end; -end; - -procedure TOptions.SetLazyWrite(newValue: Boolean); -begin - if (FLazyWrite <> newValue) then - begin - FLazyWrite := newValue; - MainForm.LazyItem.Checked := FLazyWrite; - MainForm.IniFile.LazyWrite := FLazyWrite; - if not FLazyWrite then MainForm.Modified := false; - end; {if} -end; - -procedure TOptions.SetSimple(newValue: Boolean); -begin - if (FSimple <> newValue) then - begin - FSimple := newValue; - MainForm.IniFile.Simple := FSimple; - if FSimple - then MainForm.StandardItem.Checked := true - else MainForm.EnhancedItem.Checked := true; - MainForm.TreeItemFocused(Self); - end; {if} -end; - -procedure TOptions.SetCustomColors(newValue: Boolean); -begin - if (FCustomColors <> newValue) then - begin - FCustomColors := newValue; - Mainform.UseCustomItem.Checked := newValue; - MainForm.CustColorsItem.Enabled := newValue; - MainForm.RefreshItems; - end; {if} -end; - -procedure TOptions.SetOneInstance(newValue: Boolean); -begin - if (FOneInstance <> newValue) then - begin - FOneInstance := newValue; - MainForm.OneInst.Enabled := newValue; - MainForm.OneInstItem.Checked := newValue; - end; {if} -end; - -procedure TOptions.SetSort(newValue: Boolean); -var SM : TElSSortMode; -begin - if (FSort <> newValue) then - begin - FSort := newValue; - MainForm.SortItem.Checked := FSort; - if FSort then - begin - MainForm.Tree.SortMode := smAddClick; - if MainForm.Tree.SortDir = sdAscend then SM := hsmAscend else - if MainForm.Tree.SortDir = sdDescend then SM := hsmDescend else sm:=hsmNone; - MainForm.Tree.HeaderSections[MainForm.Tree.SortSection].SortMode := SM; - MainForm.Tree.Sort(true); - end else - begin - MainForm.Tree.SortMode := smNone; - MainForm.Tree.HeaderSections[MainForm.Tree.SortSection].SortMode := hsmNone; - end; - end; {if} -end; - -destructor TOptions.Destroy; -begin - inherited Destroy; -end; - -constructor TOptions.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - StorageType := eosElIni; - IniSection := 'Options'; - FLazyWrite := true; - FSort := true; - FShowDailyTip := True; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/IniStrings.pas b/sdk/components/ElPack/BCBDemos/IniEdit/IniStrings.pas deleted file mode 100644 index 43bf3c73d5f..00000000000 --- a/sdk/components/ElPack/BCBDemos/IniEdit/IniStrings.pas +++ /dev/null @@ -1,14 +0,0 @@ -unit IniStrings; - -interface - -const sUntitled = '(Untitled)'; - sLoading = 'Loading ...'; - sSaving = 'Saving ...'; - sNewItem = 'New entry'; - sDoDelete = 'Delete selected item(s)?'; - -implementation - -end. - diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/Main.dfm b/sdk/components/ElPack/BCBDemos/IniEdit/Main.dfm deleted file mode 100644 index ca692e7de78..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/IniEdit/Main.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/Main.pas b/sdk/components/ElPack/BCBDemos/IniEdit/Main.pas deleted file mode 100644 index f0e5b528977..00000000000 --- a/sdk/components/ElPack/BCBDemos/IniEdit/Main.pas +++ /dev/null @@ -1,1641 +0,0 @@ -unit Main; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - Menus, ElTree, StdCtrls, ElStatBar, IniOpts, IniStrings, ElIni, ExtCtrls, - ElMRU, ElColorMap, ElOneInst, ElClipMon, ElList, ElCbFmts, - ElImgLst, ElClock, ComCtrls, ElPopBtn, ElTools, ElHeader, ElSpinBtn, - ElStrUtils, ActiveX, ToolWin, ElHint, ElDragDrop, ElPromptDlg -{$IFDEF VCL_4_USED} - , ImgList -{$ENDIF} - , ElTray, ElPanel, ElFrmPers, ElCaption, ElToolBar, ElDailyTip, ElBtnCtl, - ElXPThemedControl, ElBaseComp, ElTreeBtnEdit, ElTreeMemoEdit, - ElTreeSpinEdit, ElTreeCheckBoxEdit, ElTreeModalEdit, ElTreeComboBox; - -type - TMainForm = class(TForm) - Tree: TElTree; - MainMenu: TMainMenu; - FileMenu: TMenuItem; - NewItem: TMenuItem; - StatusBar: TElStatusBar; - EditMenu: TMenuItem; - OptionsMenu: TMenuItem; - StandardItem: TMenuItem; - EnhancedItem: TMenuItem; - N1: TMenuItem; - IniFile: TElIniFile; - OpenItem: TMenuItem; - SaveItem: TMenuItem; - SaveAsItem: TMenuItem; - N2: TMenuItem; - ExitItem: TMenuItem; - ModifImage: TImage; - LazyItem: TMenuItem; - N3: TMenuItem; - AutoSaveItem: TMenuItem; - SavenowItem: TMenuItem; - N4: TMenuItem; - RecentMenu: TMenuItem; - OptionsIni: TElIniFile; - MRU: TElMRU; - OpenDlg: TOpenDialog; - ColorMap: TElColorMap; - N5: TMenuItem; - ColorsSubMenu: TMenuItem; - UseCustomItem: TMenuItem; - CustColorsItem: TMenuItem; - OneInst: TElOneInstance; - N6: TMenuItem; - OneInstItem: TMenuItem; - ClipMon: TElClipboardMonitor; - Images: TElImageList; - ElClock: TElClock; - CutItem: TMenuItem; - CopyItem: TMenuItem; - PasteItem: TMenuItem; - DeleteItem: TMenuItem; - SelectAllItem: TMenuItem; - MRUPopup: TPopupMenu; - NewEntryItem: TMenuItem; - N7: TMenuItem; - RenameItem: TMenuItem; - CreateKeyItem: TMenuItem; - N8: TMenuItem; - CreateBoolItem: TMenuItem; - CreateIntItem: TMenuItem; - CreateStringItem: TMenuItem; - CreateMStringItem: TMenuItem; - CreateBinaryItem: TMenuItem; - ModifyItem: TMenuItem; - SaveDlg: TSaveDialog; - SortItem: TMenuItem; - ElTray: TElTrayIcon; - FormCaption: TElFormCaption; - ElFormPersist: TElFormPersist; - ElToolBar1: TElToolBar; - ExitBtn: TElToolButton; - ElToolButton3: TElToolButton; - NewBtn: TElToolButton; - OpenBtn: TElToolButton; - SaveBtn: TElToolButton; - DailyTipDlg: TElDailyTipDialog; - ButtonEdit: TElTreeInplaceButtonEdit; - MemoEdit: TElTreeInplaceMemoEdit; - SpinEdit: TElTreeInplaceSpinEdit; - CheckBoxEdit: TElTreeInplaceCheckBoxEdit; - ModalEdit: TElTreeInplaceModalEdit; - procedure FormCreate(Sender: TObject); - procedure StandardItemClick(Sender: TObject); - procedure EnhancedItemClick(Sender: TObject); - procedure OpenItemClick(Sender: TObject); - procedure ExitItemClick(Sender: TObject); - procedure SaveItemClick(Sender: TObject); - procedure LazyItemClick(Sender: TObject); - procedure SaveAsItemClick(Sender: TObject); - procedure SavenowItemClick(Sender: TObject); - procedure AutoSaveItemClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure MRUClick(Sender: TObject; Entry: TElMRUEntry); - procedure NewItemClick(Sender: TObject); - procedure ColorMapChange(Sender: TObject); - procedure UseCustomItemClick(Sender: TObject); - procedure CustColorsItemClick(Sender: TObject); - procedure OneInstInstanceRun(Sender: TObject; Parameters: TStrings); - procedure OneInstItemClick(Sender: TObject); - procedure DropTargetTargetDrag(Sender: TObject; State: TDragState; - Source: TOleDragObject; Shift: TShiftState; X, Y: Integer; - var DragType: TDragType); - procedure ClipMonChange(Sender: TObject); - procedure TreeItemPicDraw(Sender: TObject; Item: TElTreeItem; - var ImageIndex: Integer); - procedure SelectAllItemClick(Sender: TObject); - procedure TreeItemFocused(Sender: TObject); - procedure NewEntryItemClick(Sender: TObject); - procedure ModifyItemClick(Sender: TObject); - procedure RenameItemClick(Sender: TObject); - procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); - procedure TreeItemDeletion(Sender: TObject; Item: TElTreeItem); - procedure TreeItemSelectedChange(Sender: TObject; Item: TElTreeItem); - procedure DeleteItemClick(Sender: TObject); - procedure CopyItemClick(Sender: TObject); - procedure CutItemClick(Sender: TObject); - procedure PasteItemClick(Sender: TObject); - procedure DropTargetTargetDrop(Sender: TObject; Source: TOleDragObject; - Shift: TShiftState; X, Y: Integer; var DragType: TDragType); - procedure SortItemClick(Sender: TObject); - procedure TreeKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure FormCaptionButtonClick(Sender: TObject; - Button: TElCaptionButton); - procedure ElTrayDblClick(Sender: TObject); - procedure TreeOleDragFinish(Sender: TObject; dwEffect: TDragType; - Result: HResult); - procedure TreeOleDragStart(Sender: TObject; var dataObj: IDataObject; - var dropSource: IDropSource; var dwOKEffects: TDragTypes); - procedure TreeTryEdit(Sender: TObject; Item: TElTreeItem; - SectionIndex: Integer; var CellType: TElFieldType; - var CanEdit: Boolean); - procedure ModalEditExecute(Sender: TObject; - var Accepted: Boolean); - procedure CheckBoxEditAfterOperation(Sender: TObject; - var Accepted, DefaultConversion: Boolean); - procedure ButtonEditValidateResult(Sender: TObject; - var InputValid: Boolean); - procedure SpinEditAfterOperation(Sender: TObject; - var Accepted, DefaultConversion: Boolean); - procedure MemoEditAfterOperation(Sender: TObject; - var Accepted, DefaultConversion: Boolean); - procedure ButtonEditAfterOperation(Sender: TObject; - var Accepted, DefaultConversion: Boolean); - procedure ButtonEditBeforeOperation(Sender: TObject; - var DefaultConversion: Boolean); - private - { Private declarations } - FFileName : string; - FModified : boolean; - - // Actions - FAction : integer; // 0 - create key - // 1 - create value - // 2 - edit key name - // 3 - edit value name - // 4 - edit key value (strange name, isn't it?) - // 5 - edit value value (strange name, isn't it?) - - // FSaveCellType is needed to set the right value type after editing - FSaveCellType : TElFieldType; - - FList1 : TElList; - // the stream will hold the data prepared for OLE drag and Clipboard operations - FStream1 : TDirectMemoryStream; - FIgnoreSelect : boolean; // this one is used to prevent stack overflow in - // the method, that selects subitems - FIgnoreDelete : boolean; // this one is used to prevent deleting the INI - // records when the tree is destroyed - procedure SetFileName(NewValue : string); - procedure SetModified(NewValue : boolean); - procedure SetItemStyles(Item : TElTreeItem); - procedure PrepareCBList; - procedure DoPasteData(Item : TElTreeItem); - protected - ClipFormat: integer; - - procedure Loaded; override; - function CloseCurrent : boolean; - function DoLoad(FileName : string) : boolean; - function DoSave(FileName : string) : boolean; - procedure UpdateBtns; - procedure DoDeleteItems(Warn : boolean); - procedure AppMinimize(Sender : TObject); - public - procedure RefreshItems; - - property FileName : string read FFileName write SetFileName; - property Modified : boolean read FModified write SetModified; - end; - -type TIniDragObject = class(TInterfacedObject, IDropSource, IDataObject) - private - fEffect : LongInt; - public - // IDropSource implementation - function QueryContinueDrag(FEscapePressed: Bool; GrfKeyState: LongInt): HRESULT; StdCall; - function GiveFeedback(dwEffect: LongInt) : HRESULT; StdCall; - // IDataObject implementation - function GetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium) : HRESULT;StdCall; - function GetDataHere(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium) : HRESULT;StdCall; - function QueryGetData(const FormatEtc: TFormatEtc) : HRESULT;StdCall; - function GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; - out FormatEtcOut: TFormatEtc) : HRESULT;StdCall; - function SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; fRelease : Bool) : HRESULT;StdCall; - function EnumFormatEtc(dwDirection: LongInt; out EnumFormatEtc: IEnumFormatEtc) : HRESULT;StdCall; - function dAdvise(const FormatEtc: TFormatEtc; advf: LongInt; - const advsink: IAdviseSink; out dwConnection: LongInt) : HRESULT;StdCall; - function dUnadvise(dwConnection: LongInt) : HRESULT; StdCall; - function EnumdAdvise(out EnumAdvise: IEnumStatData) : HRESULT; StdCall; - end; - -var - MainForm: TMainForm; - -// Entry ids for color map -const cidcmNwsk = 878498542; - cidcmNwosk = 703720164; - cidcmVint = 508399275; - cidcmVbool = -131481887; - cidcmVStr = -1627567326; - cidcmVMstr = 1997096895; - cidcmVBin = -249209621; - cidcmVUndef= 850363309; - -const BoolValues : array [boolean] of string = ('False', 'True'); - -implementation - -{$R *.DFM} -{$R IniEdits.res} -{$R IniTips.res} -(* -function TIniDragObject._AddRef: Integer; -begin - Inc(FRefCount); - Result := FRefCount; -end; - -function TIniDragObject._Release: Integer; -begin - Dec(FRefCount); - if FRefCount = 0 then - begin - Destroy; - Result := 0; - Exit; - end; - Result := FRefCount; -end; - -function TIniDragObject.QueryInterface(const IID: TGUID; out Obj): HResult; -const - E_NOINTERFACE = $80004002; -begin - if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE; -end; -*) -function TIniDragObject.QueryContinueDrag(FEscapePressed: Bool; GrfKeyState: LongInt): HRESULT; -begin - if (fEscapePressed) then RESULT := dragdrop_s_cancel else - begin - if (MK_LBUTTON and grfKeyState) <>0 - then result := S_OK - else RESULT := DRAGDROP_S_DROP; - end; -end; - -function TIniDragObject.GiveFeedback(dwEffect: LongInt) : HRESULT; -begin - fEffect := dwEffect; - result := DRAGDROP_S_USEDEFAULTCURSORS; -end; - -function TIniDragObject.QueryGetData; { public } -begin - if (FormatEtc.cfFormat <> MainForm.ClipFormat) then result:= DV_E_FORMATETC - else - if (FormatEtc.dwAspect <> DVASPECT_CONTENT) then result:= DV_E_DVASPECT - else result:= S_OK; -end; { QueryGetData } - -function TIniDragObject.GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcOut: TFormatEtc) : HRESULT; { public } -begin - FormatEtcOut.ptd:=nil; - Result := E_NOTIMPL; -end; { GetCanonicalFormatEtc } - -function TIniDragObject.SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; fRelease : Bool) : HRESULT; { public } -begin - result := E_NOTIMPL; -end; { SetData } - -function TIniDragObject.dAdvise(const FormatEtc: TFormatEtc; advf: LongInt; const advsink: IAdviseSink; out dwConnection: LongInt) : HRESULT; { public } -begin - result := OLE_E_ADVISENOTSUPPORTED; -end; { dAdvise } - -function TIniDragObject.dUnadvise(dwConnection: LongInt) : HRESULT; { public } -begin - result := OLE_E_ADVISENOTSUPPORTED; -end; { dUnadvise } - -function TIniDragObject.EnumdAdvise(out EnumAdvise: IEnumStatData) : HRESULT; { public } -begin - result := OLE_E_ADVISENOTSUPPORTED; -end; { EnumdAdvise } - -function TIniDragObject.EnumFormatEtc(dwDirection: LongInt; out EnumFormatEtc: IEnumFormatEtc) : HRESULT; { public } -var F : PFormatEtc; -begin - if (dwDirection = DATADIR_GET) then - begin - New(F); - F^.cfFormat := MainForm.ClipFormat; - F^.ptd := nil; - F^.dwAspect := DVASPECT_CONTENT; - F^.lIndex := -1; - F^.tymed := TYMED_HGLOBAL; - EnumFormatEtc := (TEnumFormatEtc.Create(PFormatList(F), 1, 0) as IEnumFormatEtc); - result := S_OK; - end - else - if (dwDirection = DATADIR_SET) then result := E_NOTIMPL - else result := E_INVALIDARG; -end; { EnumFormatEtc } - -function TIniDragObject.GetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium) : HRESULT; { public } -begin - Medium.tymed := 0; - Medium.UnkForRelease := nil; - Medium.hGlobal := 0; - if (FormatEtcIn.cfFormat = MainForm.ClipFormat) and - (FormatEtcIn.dwAspect = DVASPECT_CONTENT) and - (FormatEtcIn.tymed = TYMED_HGLOBAL) then - begin - if (MainForm.FStream1)<>nil then - begin - Medium.hGlobal := GlobalAlloc(GMEM_SHARE OR GMEM_ZEROINIT, MainForm.FStream1.Size); - if (Medium.hGlobal = 0) then - begin - result := E_OUTOFMEMORY; - Exit; - end; - medium.tymed := TYMED_HGLOBAL; - result := GetDataHere(FormatEtcIn, Medium); - end else result := E_UNEXPECTED; - end - else result := DV_E_FORMATETC; -end; { GetData } - -function TIniDragObject.GetDataHere(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium) : HRESULT; { public } -var p:pointer; -begin - if (FormatEtcIn.cfFormat = MainForm.ClipFormat) and - (FormatEtcIn.dwAspect = DVASPECT_CONTENT) and - (FormatEtcIn.tymed = TYMED_HGLOBAL) and (Medium.tymed = TYMED_HGLOBAL) then - begin - if (Medium.hGlobal = 0) then - begin - result := E_OUTOFMEMORY; - Exit; - end; - p := GlobalLock(Medium.hGlobal); - if (MainForm.FStream1)<>nil then - begin - MoveMemory(p, MainForm.FStream1.Memory, MainForm.FStream1.Size); - GlobalUnlock(Medium.hGlobal); - result := S_OK; - // now remove the old data - if fEffect = DROPEFFECT_MOVE then MainForm.DoDeleteItems(false); - end - else result := E_UNEXPECTED; - Medium.UnkForRelease := nil; - end - else - result := DV_E_FORMATETC; -end; { GetDataHere } - -(*///////////////////////////////////////////////////////////////////////////// - -Main form - -/////////////////////////////////////////////////////////////////////////////*) - -procedure TMainForm.UpdateBtns; -var b : boolean; -begin - b := Tree.SelectedCount >0; - if Assigned(CopyItem) then CopyItem.Enabled := b; - if Assigned(CutItem) then CutItem.Enabled := b; - if Assigned(DeleteItem) then DeleteItem.Enabled := b; -end; - -procedure TMainForm.Loaded; -begin - inherited; -end; - -procedure TMainForm.SetModified(NewValue : boolean); -begin - if NewValue <> FModified then - begin - if (not Options.LazyWrite) and (NewValue) then exit; - FModified := NewValue; - if FModified then ModifImage.Picture.Bitmap.LoadFromResourceName(hInstance, 'EXCLAMATION') - else ModifImage.Picture.Bitmap.Assign(nil); - SaveItem.Enabled := Modified; - SaveBtn.Enabled := Modified; - end; -end; - -function TMainForm.CloseCurrent : boolean; -begin - if FModified then - begin - case MessageDlg(Format('%s was modified. Save it now?', [FileName]), mtWarning , [mbYes, mbNo, mbCancel], 0) of - mrYes: result := DoSave(FileName); - mrNo: result := true; - else result := false; - end; - end else result := true; - if Result then - begin - IniFile.Path := ''; - FIgnoreDelete := true; - Tree.Items.Clear; - FIgnoreDelete := false; - FileName := sUntitled; - Modified := false; - end; -end; - -procedure TMainForm.SetFileName(NewValue : string); -begin - FFileName := newValue; - FormCaption.Texts[3].Caption := FFileName; -end; - -procedure TMainForm.FormCreate(Sender: TObject); -begin - SetHintWindow; - FileName := sUntitled; - OptionsIni.Path := ExtractFilePath(ParamStr(0)) + 'IniEdit.ini'; - try - OptionsIni.Load; // this is necessary!!! - except - end; - Options := TOptions.Create(nil); - Options.Storage := OptionsIni; - Options.AutoSave := true; - Options.Load; - ColorMap.Restore; - MRU.Restore; - Tree.Restore; - StatusBar.Restore; - Modified := false; - ClipFormat := RegisterClipboardFormat('EldoS IniEditor items format'); - FAction := -1; - FList1 := TElList.Create; - if ParamCount >0 then - begin - Options.Simple := (Uppercase(ExtractFileExt(ParamStr(1))) <> '.EIF'); - if DoLoad(ParamStr(1)) then - begin - FileName := ParamStr(1); - if Uppercase(ExtractFileExt(FileName)) = '.EIF' then MRU.Sections[0].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INF' then MRU.Sections[2].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INI' then MRU.Sections[1].Add(FileName, 0) else - MRU.Sections[3].Add(FileName, 0); - end; - end; - Application.OnMinimize := AppMinimize; - DailyTipDlg.ShowNextTime := Options.ShowDailyTip; - if Options.ShowDailyTip then - begin - DailyTipDlg.Execute; - Options.ShowDailyTip := DailyTipDlg.ShowNextTime; - end; -end; - -procedure TMainForm.FormDestroy(Sender: TObject); -begin - if Assigned(FList1) then - begin - FList1.Free; - FList1 := nil; - end; - if Assigned(FStream1) then - begin - FStream1.Free; - FStream1 := nil; - end; - MRU.Save; - ColorMap.Save; - StatusBar.Save; - Tree.Save; - Options.Free; -end; - -procedure TMainForm.StandardItemClick(Sender: TObject); -begin - Options.Simple := true; - Modified := true; -end; - -procedure TMainForm.EnhancedItemClick(Sender: TObject); -begin - Options.Simple := false; - Modified := true; -end; - -procedure TMainForm.OpenItemClick(Sender: TObject); -begin - if OpenDlg.Execute then - begin - if not CloseCurrent then exit; - Options.Simple := (Uppercase(ExtractFileExt(OpenDlg.FileName)) <> '.EIF'); - if DoLoad(OpenDlg.FileName) then - begin - FileName := OpenDlg.FileName; - if Uppercase(ExtractFileExt(FileName)) = '.EIF' then MRU.Sections[0].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INF' then MRU.Sections[2].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INI' then MRU.Sections[1].Add(FileName, 0) else - MRU.Sections[3].Add(FileName, 0); - end; - end; -end; - -procedure TMainForm.ExitItemClick(Sender: TObject); -begin - Close; -end; - -function TMainForm.DoLoad; - - procedure IntFillData(Key, Value : string; Item : TElTreeItem); - var bval : boolean; - sval : string; - ival : integer; - - begin - case IniFile.GetValueType(Key, Value) of - evtBoolean: - begin - IniFile.ReadBool(Key, Value, false, bval); - if bval then Item.ColumnText.Add('True') else Item.ColumnText.Add('False'); - Item.Data := pointer(Integer(Item.Data) or (ord(evtBoolean) shl 1)); - end; - evtInt: - begin - IniFile.ReadInteger(Key, Value, 0, ival); - Item.ColumnText.Add(IntToStr(ival)); - Item.Data := pointer(Integer(Item.Data) or (ord(evtInt) shl 1)); - end; - evtString: - begin - IniFile.ReadString(Key, Value, '', sval); - Item.ColumnText.Add(sval); - Item.Data := pointer(Integer(Item.Data) or (ord(evtString) shl 1)); - end; - evtMultiString: - begin - IniFile.ReadString(Key, Value, '', sval); - while true do - if not Replace(sval, #13#10, #32) then break; - Item.ColumnText.Add(sval); - Item.Data := pointer(Integer(Item.Data) or (ord(evtMultiString) shl 1)); - end; - evtBinary: - begin - IniFile.ReadString(Key, Value, '', sval); - Item.ColumnText.Add(sval); - Item.Data := pointer(Integer(Item.Data) or (ord(evtBinary) shl 1)); - end; - else Item.ColumnText.Add(''); - end; //case - Item.ColumnText.Add(''); - SetItemStyles(Item); - end; - - procedure IntLoad(KeyName : string; Parent : TElTreeItem); - var Item : TElTreeItem; - List : TStringList; - SaveKey : string; - SubKey : string; - i : integer; - - begin - List := TStringList.Create; - SaveKey := IniFile.CurrentKey; - if IniFile.OpenKey(KeyName, false) then - begin - IniFile.EnumSubKeys('', List); - for i := 0 to List.Count -1 do - begin - Item := Tree.Items.AddChildObject(Parent, List[i], TObject(1)); - if KeyName = IniFile.Delimiter - then SubKey := KeyName + List[i] - else SubKey := IniFile.CurrentKey + IniFile.Delimiter + List[i]; - IntFillData(SubKey, '', Item); - IntLoad(SubKey, Item); - end; - List.Clear; - IniFile.EnumValues('', List); - for i := 0 to List.Count - 1 do - begin - Item := Tree.Items.AddChild(Parent, List[i]); - IntFillData('', List[i], Item); - end; // for - end; - IniFile.OpenKey(SaveKey, false); - List.Free; - end; - -var b: boolean; - -begin - IniFile.Path := FileName; - StatusBar.Panels[0].Text := sLoading; - result := IniFile.Load; - b := Options.Sort; - Options.Sort := false; - Tree.Items.BeginUpdate; - IntLoad(IniFile.Delimiter, nil); - Options.Sort := b; - Tree.Items.EndUpdate; - StatusBar.Panels[0].Text := ''; -end; - -function TMainForm.DoSave; -begin - IniFile.Path := FileName; - StatusBar.Panels[0].Text := sSaving; - result := IniFile.Save; - StatusBar.Panels[0].Text := ''; - Modified := false; -end; - -procedure TMainForm.SaveItemClick(Sender: TObject); -begin - if FileName = sUntitled then SaveAsItemClick(Sender) else DoSave(FileName); -end; - -procedure TMainForm.LazyItemClick(Sender: TObject); -begin - Options.LazyWrite := not Options.LazyWrite; -end; - -procedure TMainForm.SaveAsItemClick(Sender: TObject); -begin - if SaveDlg.Execute then - begin - if DoSave(SaveDlg.FileName) then FileName := SaveDlg.FileName; - end; -end; - -procedure TMainForm.SavenowItemClick(Sender: TObject); -begin - Options.Save; - OptionsIni.Save; -end; - -procedure TMainForm.AutoSaveItemClick(Sender: TObject); -begin - Options.AutoSave := not Options.AutoSave; -end; - -procedure TMainForm.MRUClick(Sender: TObject; Entry: TElMRUEntry); -begin - if not CloseCurrent then exit; - Options.Simple := (Uppercase(ExtractFileExt(Entry.Name)) <> '.EIF'); - if DoLoad(Entry.Name) then - begin - FileName := Entry.Name; - if Uppercase(ExtractFileExt(FileName)) = '.EIF' then MRU.Sections[0].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INF' then MRU.Sections[2].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INI' then MRU.Sections[1].Add(FileName, 0) else - MRU.Sections[3].Add(FileName, 0); - end; -end; - -procedure TMainForm.NewItemClick(Sender: TObject); -begin - CloseCurrent; -end; - -procedure TMainForm.ColorMapChange(Sender: TObject); -begin - RefreshItems; -end; - -procedure TMainForm.UseCustomItemClick(Sender: TObject); -begin - Options.CustomColors := not Options.CustomColors; -end; - -procedure TMainForm.CustColorsItemClick(Sender: TObject); -begin - ColorMap.Edit('Custom colors'); -end; - -procedure TMainForm.OneInstInstanceRun(Sender: TObject; - Parameters: TStrings); -begin - if Parameters.Count < 2 then Exit; - if not CloseCurrent then exit; - Options.Simple := (Uppercase(ExtractFileExt(Parameters[1])) <> '.EIF'); - if DoLoad(Parameters[1]) then - begin - FileName := Parameters[1]; - if Uppercase(ExtractFileExt(FileName)) = '.EIF' then MRU.Sections[0].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INF' then MRU.Sections[2].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INI' then MRU.Sections[1].Add(FileName, 0) else - MRU.Sections[3].Add(FileName, 0); - end; -end; - -procedure TMainForm.OneInstItemClick(Sender: TObject); -begin - Options.OneInstance := not Options.OneInstance; -end; - -procedure TMainForm.ClipMonChange(Sender: TObject); -var b: boolean; -begin - b := ClipMon.DataFormats.IndexOf(GetFormatName(ClipFormat))<>-1; - PasteItem.Enabled := b; -end; - -procedure TMainForm.TreeItemPicDraw(Sender: TObject; Item: TElTreeItem; - var ImageIndex: Integer); -begin - if (Integer(Item.Data)) mod 2 = 1 then - begin - if Item.Focused then ImageIndex := 1 else - if Item.Expanded then ImageIndex := 0 else ImageIndex := 2; - end else - begin - if Item.Focused then ImageIndex := 4 else ImageIndex := 3; - end; -end; - -procedure TMainForm.SelectAllItemClick(Sender: TObject); -begin - Tree.SelectAll; - UpdateBtns; -end; - -procedure TMainForm.TreeItemFocused(Sender: TObject); -var b : boolean; -begin - UpdateBtns; - if Options.Simple then - begin - b := (Tree.ItemFocused <> nil) and (Tree.ItemFocused.Level = 0); - CreateKeyItem.Enabled := true; - CreateBoolItem.Enabled := b; - CreateIntItem.Enabled := b; - CreateStringItem.Enabled := b; - CreateMStringItem.Enabled := false; - CreateBinaryItem.Enabled := false; - end else - begin - CreateKeyItem.Enabled := true; - CreateBoolItem.Enabled := true; - CreateIntItem.Enabled := true; - CreateStringItem.Enabled := true; - CreateMStringItem.Enabled := true; - CreateBinaryItem.Enabled := true; - end; - b := (Tree.ItemFocused <> nil); - ModifyItem.Enabled := b; - RenameItem.Enabled := b; -end; - -procedure TMainForm.NewEntryItemClick(Sender: TObject); -var NewItem, ParentItem : TElTreeItem; - Key : string; - EType : integer; -begin - ParentItem := Tree.ItemFocused; - EType := TMenuItem(Sender).Tag; - if Options.Simple and (EType = 0) then ParentItem := nil; - if ParentItem = nil - then Key := IniFile.Delimiter - else Key := ParentItem.GetFullName(IniFile.Delimiter); - Tree.IsUpdating := true; - NewItem := Tree.Items.AddChild(ParentItem, sNewItem); - case EType of - 1: NewItem.ColumnText.Add('False'); - 2: NewItem.ColumnText.Add('0'); - else NewItem.ColumnText.Add(''); - end; - NewItem.ColumnText.Add(''); - if ParentItem <> nil then - begin - ParentItem.Data := pointer(Integer(ParentItem.Data) or 1); - SetItemStyles(ParentItem); - end; - if EType = 0 then NewItem.Data := pointer(1) else NewItem.Data := pointer((EType) shl 1); - SetItemStyles(NewItem); - if EType <> 0 - then FAction := 1 - else FAction := 0; - Tree.ItemFocused := NewItem; - Tree.IsUpdating := false; - NewItem.EditText; -end; - -procedure TMainForm.RefreshItems; - - procedure IntUpdProc(Item:TElTreeItem; Index: integer; var ContinueIterate:boolean; - IterateData:pointer; Tree:TCustomElTree); - begin - MainForm.SetItemStyles(Item); - end; - -begin - Tree.Items.BeginUpdate; - try - Tree.Items.Iterate(false, true, @IntUpdProc, nil); - finally - Tree.Items.EndUpdate; - end; -end; -{$HINTS OFF} -procedure TMainForm.SetItemStyles(Item : TElTreeItem); -var C : TColorEntry; - S : TElCellStyle; - i : integer; -begin - Tree.Items.BeginUpdate; - Item.UseStyles := true; - while Item.StylesCount > 0 do Item.RemoveStyle(Item.Styles[0]); - if Item.HasChildren - then C := ColorMap.Items[ColorMap.EntryByID(cidcmNwsk)] - else C := ColorMap.Items[ColorMap.EntryByID(cidcmNwosk)]; - with Item.MainStyle do - begin - TextFlags := 0; - OwnerProps := not Options.CustomColors; - FontName := Font.Name; - FontSize := Font.Size; - FontStyles := Font.Style; - CellBkColor := C.BkColor; - TextColor := C.FgColor; - TextBkColor := CellBkColor; - Style := ElhsText; - CellType := sftText; - end; - S := Item.AddStyle; - i := Integer(Item.Data) shr 1; - case i of - 0: i := cidcmVUndef; - 1: i := cidcmVbool; - 2: i := cidcmVInt; - 3: i := cidcmVStr; - 4: i := cidcmVMStr; - 5: i := cidcmVBin; - end; - C := ColorMap.Items[ColorMap.EntryByID(i)]; - with S do - begin - OwnerProps := not Options.CustomColors; - FontName := Font.Name; - FontSize := Font.Size; - FontStyles := Font.Style; - CellBkColor := C.BkColor; - TextColor := C.FgColor; - TextBkColor := CellBkColor; - TextFlags := 0; - Style := ElhsText; - i := Integer(Item.Data) shr 1; - case i of - 0: CellType := sftText; - 1: CellType := sftEnum; - 2: CellType := sftNumber; - 3: CellType := sftText; - 4: CellType := sftCustom; - 5: CellType := sftBlob; - end; - end; - S := Item.AddStyle; // this one is for column with value type - Tree.Items.EndUpdate; -end; -{$HINTS ON} - -procedure TMainForm.ModifyItemClick(Sender: TObject); -begin - Tree.EditItem(Tree.ItemFocused, 1); - SetItemStyles(Tree.ItemFocused); -end; - -procedure TMainForm.RenameItemClick(Sender: TObject); -begin - Tree.EditItem(Tree.ItemFocused, 0); -end; - -procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); -begin - CanClose := CloseCurrent; -end; - -procedure TMainForm.DoDeleteItems(Warn : boolean); -begin - FList1.Clear; - Tree.AllSelected(FList1); - if FList1.Count >0 then - begin - if Warn and (MessageDlg(sDoDelete, mtWarning, [mbYes, mbNo], 0)= mrNo) then - begin - FList1.Clear; - exit; - end; - Tree.Items.BeginUpdate; - while FList1.Count > 0 do - Tree.Items.DeleteItem(TElTreeItem(FList1[0])); - Tree.Items.EndUpdate; - end; -end; - -procedure TMainForm.TreeItemDeletion(Sender: TObject; Item: TElTreeItem); -var Key, Value : string; - i : integer; -begin - if FIgnoreDelete then exit; - Key := Item.GetFullName(IniFile.Delimiter); - i := LastPos(IniFile.Delimiter, Key); - Value := Copy(Key, i + 1, Length(Key)); - Key := Copy(Key, 1, i - 1); - IniFile.Delete(Key, Value); - if Assigned(FList1) then FList1.Remove(Item); -end; - -procedure TMainForm.TreeItemSelectedChange(Sender: TObject; - Item: TElTreeItem); - -type TSRec = record - Parent : TElTreeItem; - end; - PSRec = ^TSRec; - - procedure IntSel (Item:TElTreeItem; Index: integer; var ContinueIterate:boolean; - IterateData:pointer; Tree:TCustomElTree); - begin - if not (Item.IsUnder(PSRec(IterateData).Parent)) then - ContinueIterate := false - else - Item.Selected := true; - end; - -var SRec : TSrec; - -begin - // Selecting an item should also cause selection of all it's subitems: - // if any operation (like deletion or cut or copy) is executed, - // subitems follow the item. - // So deselection of the item when one of it's parents is selected - // is nonsence. - if Item.Selected and (not FIgnoreSelect) then - begin - FIgnoreSelect := true; - SRec.Parent := Item; - Tree.Items.BeginUpdate; - Tree.Items.IterateFrom(false, true, @IntSel, @SRec, Item); - Tree.Items.EndUpdate; - FIgnoreSelect := false; - end else - if not Item.Selected then - begin - SRec.Parent := Item.Parent; - while SRec.Parent<>nil do - begin - if SRec.Parent.Selected then - begin - Item.Selected := true; - exit; - end else SRec.Parent := SRec.Parent.Parent; - end; // while - end; -end; - -procedure TMainForm.DoPasteData(Item : TElTreeItem); - -var NoMessageKey, - NoMessageVal, - NoMessageVal2 : boolean; - TempKey : TElTreeItem; - - function UniqueEntryName(Key, Value : string) : string; - var i, j : integer; - SList1, SList2 : TStringList; - nf : boolean; - begin - result := UpperCase(Value); - SList1 := TStringList.Create; - SList2 := TStringList.Create; - IniFile.EnumSubKeys(Key, SList1); - IniFile.EnumValues(Key, SList2); - j := 0; - while true do - begin - nf := true; - for i := 0 to SList1.Count - 1 do - begin - if result = Uppercase(SList1[i]) then - begin - nf := false; - break; - end; - end; - if nf then - begin - for i := 0 to SList2.Count - 1 do - begin - if result = Uppercase(SList2[i]) then - begin - nf := false; - break; - end; - end; - end; - if nf then - begin - if j > 0 - then result := Value + '(' + IntToStr(j) + ')' - else result := Value; - exit; - end; - inc(j); - result := UpperCase(Value) + '(' + IntToStr(j) + ')'; - end; - SList1.Free; - SList2.Free; - end; - - procedure IntPaste(Parent : TElTreeItem); - var Item : TElTreeItem; - S : String; - i,j : integer; - b : boolean; - p : pointer; - IsKey : boolean; - Key, Value, FOldKey : string; - SList : TStringList; - - begin - ReadStringFromStream(FStream1, S); - FStream1.ReadBuffer(j, sizeof(integer)); - IsKey := (j mod 2) = 1; - if (IniFile.Simple) and (IsKey xor (Parent = nil)) then - begin - if IsKey then - begin - if not NoMessageKey then - begin - MessageDlg('In "Simple" mode keys can not be pasted to a key.'#13#10 + - 'Some values will be pasted to "root".', mtError, [mbOk], 0); - NoMessageKey := true; - end; - Parent := nil; - end else - begin - if not NoMessageVal then - begin - MessageDlg('In "Simple" mode values can be pasted only to some key.'#13#10 + - 'Some values will be pasted to the temporary key.', mtError, [mbOk], 0); - NoMessageVal := true; - end; - if TempKey = nil then - begin - TempKey := Tree.Items.AddChildObject(nil, UniqueEntryName(IniFile.Delimiter, 'Temporary'), TObject(1)); - FOldKey := IniFile.CurrentKey; - IniFile.OpenKey(IniFile.Delimiter + TempKey.Text, true); - IniFile.OpenKey(FOldKey, false); - end; - Parent := TempKey; - end; - end; - if IniFile.Simple and (Parent <> nil) and (Integer(Parent.Data) mod 2 = 0) then - begin - if not NoMessageVal2 then - begin - MessageDlg('In "Simple" mode source values can''t be pasted to other values.'#13#10 + - 'Source values will be pasted to the destination value parent key.', mtError, [mbOk], 0); - NoMessageVal2 := true; - end; - Parent := Parent.Parent; - end; - begin - if Parent = nil - then Key := IniFile.Delimiter - else Key := Parent.GetFullName(IniFile.Delimiter) + IniFile.Delimiter; - Value := UniqueEntryName(Key, S); - Item := Tree.Items.AddChildObject(Parent, Value, TObject(j)); - Item.Selected := true; - if IsKey then // we have to create an entry and set it as a key - begin - FOldKey := IniFile.CurrentKey; - IniFile.OpenKey(Key + Value, true); - IniFile.OpenKey(FOldKey, false); - end; - case (j shr 1) of // - 1: - begin - FStream1.ReadBuffer(b, sizeof(boolean)); - IniFile.WriteBool(Key, Item.Text, b); - if b then Item.ColumnText.Add('True') else Item.ColumnText.Add('False'); - end; - 2: - begin - FStream1.ReadBuffer(i, sizeof(integer)); - IniFile.WriteInteger(Key, Item.Text, i); - Item.ColumnText.Add(IntToStr(i)); - end; - 3: - begin - ReadStringFromStream(FStream1, S); - IniFile.WriteString(Key, Item.Text, S); - Item.ColumnText.Add(s); - end; - 4: - begin - ReadStringFromStream(FStream1, S); - SList := TStringList.Create; - SList.Text := S; - while true do - if not Replace(s, #13#10, #32) then break; - Item.ColumnText.Add(s); - IniFile.WriteMultiString(Key, ITem.Text, SList); - SList.Free; - end; - 5: - begin - FStream1.ReadBuffer(i, sizeof(integer)); - GetMem(P, i); - FStream1.ReadBuffer(PChar(p)^, i); - IniFile.WriteBinary(Key, Item.Text, PChar(p)^, i); - IniFile.ReadString(Key, Item.Text, '', s); - Item.ColumnText.Add(s); - FreeMem(P); - end; - end; // case - Item.ColumnText.Add(''); - SetItemStyles(Item); - end; // else - FStream1.ReadBuffer(j, sizeof(integer)); - for i := 0 to j - 1 do IntPaste(Item); - end; - -var i : integer; -begin - NoMessageKey := false; - NoMessageVal := false; - NoMessageVal2:= false; - TempKey := nil; - Modified := True; - try - try - Tree.Items.BeginUpdate; - repeat - FStream1.ReadBuffer(i, sizeof(integer)); - Tree.DeselectAll; - if i = ord('D') then IntPaste(Item) else break; - until false; - finally - Tree.Items.EndUpdate; - end; - except - end; -end; - -procedure TMainForm.PrepareCBList; - - procedure DoPrepare(Item : TElTreeItem); - var b : boolean; - S : string; - i : integer; - bd: pointer; - bl: integer; - Key : string; - - begin - FList1.Remove(Item); - WriteStringToStream(FStream1, Item.Text); - FStream1.WriteBuffer(Integer(Item.Data), sizeof(integer)); - if Item.Parent = nil - then Key := IniFile.Delimiter - else Key := Item.Parent.GetFullName(IniFile.Delimiter); - case (Integer(Item.Data) shr 1) of // - 1: - begin - IniFile.ReadBool(Key, Item.Text, false, b); - FStream1.WriteBuffer(b, sizeof(boolean)); - end; - 2: - begin - IniFile.ReadInteger(Key, Item.Text, 0, i); - FStream1.WriteBuffer(i, sizeof(integer)); - end; - 3, - 4: - begin - IniFile.ReadString(Key, Item.Text, '', S); - WriteStringToStream(FStream1, S); - end; - 5: - begin - bd := nil; - bl := 0; - IniFile.ReadBinary(Key, Item.Text, bd, bl); - GetMem(bd, bl); - IniFile.ReadBinary(Key, Item.Text, bd, bl); - FStream1.WriteBuffer(bl, sizeof(integer)); - FStream1.WriteBuffer(bd, bl); - end; - end; // case - i := Item.Count; - FStream1.WriteBuffer(i, sizeof(integer)); - for i := 0 to Item.Count - 1 do // Iterate - DoPrepare(Item.Children[i]); - end; - -var i : integer; - -begin - if FStream1 <> nil - then FStream1.SetSize(0) - else FStream1 := TDirectMemoryStream.Create; - FList1.Clear; - Tree.AllSelected(FList1); - while FList1.Count > 0 do - begin - i := ord('D'); // write a marker to the stream - FStream1.WriteBuffer(i, sizeof(integer)); - DoPrepare(TElTreeItem(FList1[0])); - end; - i := ord('E'); // write End of Stream marker - FStream1.WriteBuffer(i, sizeof(integer)); -end; - -procedure TMainForm.DeleteItemClick(Sender: TObject); -begin - DoDeleteItems(true); -end; - -procedure TMainForm.CopyItemClick(Sender: TObject); -var CBHandle : HGLOBAL; - P : Pointer; -begin - if OpenClipboard(Handle) then - begin - PrepareCBList; - EmptyClipboard; - CBHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, FStream1.Size); - P := GlobalLock(CBHandle); - if p <> nil then - begin - MoveMemory(p, FStream1.Memory, FStream1.Size); - GlobalUnlock(CBHandle); - SetClipboardData(ClipFormat, CBHandle); - end; - CloseClipboard; - end; -end; - -procedure TMainForm.CutItemClick(Sender: TObject); -begin - CopyItemClick(Self); - DoDeleteItems(false); - Modified := true; -end; - -procedure TMainForm.PasteItemClick(Sender: TObject); -var CBHandle : HGLOBAL; - P : Pointer; - fmt :integer; -begin - if OpenClipboard(Handle) then - begin - fmt := 0; - repeat - fmt := EnumClipboardFormats(fmt); - if fmt=ClipFormat then break; - until fmt = 0; - if fmt=ClipFormat then // we can paste data - begin - CBHandle := GetClipboardData(ClipFormat); - if CBHandle <> 0 then - begin - p := GlobalLock(CBHandle); - if p <> nil then - begin - if FStream1 <> nil - then FStream1.SetSize(0) - else FStream1 := TDirectMemoryStream.Create; - // as we don't know the size of the stream, - // we assume it to be the maximum possible - FStream1.SetPointer(p, $7FFFFFFF); - // now read the data - DoPasteData(Tree.ItemFocused); - // now unlock the data - FStream1.SetPointer(nil, 0); - GlobalUnlock(CBHandle); - Modified := true; - end; // if - end; // if - end; //if - CloseClipboard; - end; - -end; - -procedure TMainForm.DropTargetTargetDrag(Sender: TObject; - State: TDragState; Source: TOleDragObject; Shift: TShiftState; X, - Y: Integer; var DragType: TDragType); -var FL: TStringList; -begin - DragType := dtNone; - if Source.HasDataFormat(ClipFormat) then - begin - if ssCtrl in Shift then DragType := dtCopy else - if Shift = [ssLeft] then DragType := dtMove else DragType := dtNone; - exit; - end; - if Source.HasDataFormat(CF_HDROP) then - begin - FL := Source.FileList; - if (FL.Count > 0) and FileExists(FL[0]) then DragType := dtLink; - end; -end; - -procedure TMainForm.DropTargetTargetDrop(Sender: TObject; - Source: TOleDragObject; Shift: TShiftState; X, Y: Integer; - var DragType: TDragType); -var FL: TStringList; - mdm: TStgMedium; - pz : pchar; - fmt : TFormatEtc; - efe : iEnumFormatEtc; - fmtCount: LongInt; - Item : TElTreeItem; - ItemPart : TSTItemPart; - HitColumn : integer; - Key : string; - -begin - Item := Tree.GetItemAt(X, Y, ItemPart, HitColumn); - if Item <> nil - then Key := Item.GetFullName(IniFile.Delimiter) - else Key := IniFile.Delimiter; - if ssCtrl in Shift then DragType := dtCopy else - if Shift = [] then DragType := dtMove else DragType := dtNone; - if ((DragType = dtCopy) or (DragType = dtMove)) and Source.HasDataFormat(ClipFormat) then - begin - fillchar(fmt,sizeof(fmt),0); - Source.DataObject.EnumFormatEtc(datadir_get,efe); - EFE.Reset; - repeat - fmtCount:=0; - efe.Next(1,fmt,@fmtCount); - until (fmt.cfFormat = ClipFormat) or (fmtCount=0); - if fmt.cfFormat<>ClipFormat then exit; - fmt.tymed := TYMED_HGLOBAL; - fmt.lindex := -1; - if Source.DataObject.GetData(fmt,mdm)<>S_OK then exit else - try - if (fmt.cfFormat=ClipFormat) and (mdm.tymed = TYMED_HGLOBAL) then - begin - // This is a dirty trick: - // if the Key doesn't exist in INI file, then we are moving the data, - // and are trying to move the data to Key's subitem, that was already deleted ;). - // As this is not allowed, we give a message and move data to the root - if not(IniFile.KeyExists(Key) - or IniFile.ValueExists(Copy(Key, 1, LastPos(IniFile.Delimiter, Key) -1), - Copy(Key, LastPos(IniFile.Delimiter, Key) + 1, Length(Key)))) then - begin - MessageDlg('Can''t move a key to itself or its subkey. Moving to "root" ... ', mtError, [mbOk], 0); - Item := nil; - end; - pz := GlobalLock(mdm.HGlobal); - if FStream1 <> nil - then FStream1.SetSize(0) - else FStream1 := TDirectMemoryStream.Create; - FStream1.SetPointer(pz, $7FFFFFFF); - DoPasteData(Item); - FStream1.SetPointer(nil, 0); - GlobalUnlock(mdm.HGlobal); - end; - finally - if Assigned(mdm.unkForRelease) then Iunknown(mdm.unkForRelease)._Release; - end; - end; - if Source.HasDataFormat(CF_HDROP) then - begin - if Source is TOleDragObject then - begin - FL := Source.FileList; - if (FL.Count > 0) and FileExists(FL[0]) then - begin - if CloseCurrent then - begin - Options.Simple := (Uppercase(ExtractFileExt(FL[0])) <> '.EIF'); - if DoLoad(FL[0]) then - begin - FileName := FL[0]; - if Uppercase(ExtractFileExt(FileName)) = '.EIF' then MRU.Sections[0].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INF' then MRU.Sections[2].Add(FileName, 0) else - if Uppercase(ExtractFileExt(FileName)) = '.INI' then MRU.Sections[1].Add(FileName, 0) else - MRU.Sections[3].Add(FileName, 0); - end; - end; - end; // if - end; - end; -end; - -procedure TMainForm.SortItemClick(Sender: TObject); -begin - Options.Sort := not Options.Sort; -end; - -procedure TMainForm.TreeKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - if (Shift = [ssCtrl]) and ((Key = ord('A')) or (Key = ord('a'))) then Tree.SelectAll; -end; - -procedure TMainForm.FormCaptionButtonClick(Sender: TObject; - Button: TElCaptionButton); -begin - ElFormPersist.Topmost := Button.Down; -end; - -procedure TMainForm.ElTrayDblClick(Sender: TObject); -begin - ShowWindow(Application.Handle, SW_SHOW); - ElTray.Enabled := false; - Application.Restore; - Application.BringToFront; -end; - -procedure TMainForm.AppMinimize(Sender : TObject); -begin - ShowWindow(Application.Handle, SW_HIDE); - ElTray.Enabled := true; -end; - -procedure TMainForm.TreeOleDragStart(Sender: TObject; var dataObj: IDataObject; - var dropSource: IDropSource; var dwOKEffects: TDragTypes); -var DragObj : TIniDragObject; -begin - PrepareCBList; - DragObj := TIniDragObject.Create; - DragObj.QueryInterface(IDataObject, dataObj); - DragObj.QueryInterface(IDropSource, dropSource); - dwOKEffects := [dtCopy, dtMove]; -end; - -procedure TMainForm.TreeTryEdit(Sender: TObject; Item: TElTreeItem; - SectionIndex: Integer; var CellType: TElFieldType; var CanEdit: Boolean); -begin - if FAction = -1 then // we have to define, what we are going to edit - begin - if (SectionIndex = 0) then // editing name - begin - if Integer(Item.Data) mod 2 = 1 then - FAction := 2 // editing a key - else - FAction := 3; // editing a value - end - else // editing value ... - begin - if Integer(Item.Data) mod 2 = 1 then - begin - FAction := 4; - CellType := sftText; - end - else - FAction := 5; - end; - end; - FSaveCellType := CellType; -end; - -procedure TMainForm.ModalEditExecute(Sender: TObject; - var Accepted: Boolean); -begin - ElMessageDlg('Unfortunately editing binary values is not implemented', mtInformation, [mbOk], 0); -end; - -procedure TMainForm.TreeOleDragFinish(Sender: TObject; dwEffect: TDragType; Result: HResult); -begin - Modified := true; -end; - -procedure TMainForm.CheckBoxEditAfterOperation( - Sender: TObject; var Accepted, DefaultConversion: Boolean); -var Key : String; -begin - DefaultConversion := false; - Accepted := true; - - CheckBoxEdit.Item.ColumnText[0] := BoolValues[CheckBoxEdit.Editor.Checked]; - if CheckBoxEdit.Item.Parent <> nil then - Key := CheckBoxEdit.Item.Parent.GetFullName(IniFile.Delimiter) - else - Key := IniFile.Delimiter; - IniFile.WriteBool(Key, CheckBoxEdit.Item.Text, CheckBoxEdit.Editor.Checked); - Modified := true; - FAction := -1; -end; - -procedure TMainForm.ButtonEditValidateResult(Sender: TObject; - var InputValid: Boolean); -var Text : string; - Key : string; -begin - if (FAction <> 4) and (FAction <> 5) then - begin - Text := ButtonEdit.Editor.Text; - - if (Pos(IniFile.Delimiter, Text) >0) or - (Pos(IniFile.Comment, Text) >0) or - (Pos('=', Text) > 0) then - begin - MessageBox(0, PChar(Format('Invalid characters in key/value name ("=" or "%s" or "%s").', - [IniFile.Delimiter, IniFile.Comment])), nil, MB_OK); - InputValid := false; - exit; - end; - if Length(Text) = 0 then - begin - MessageBox(0, 'Empty names are not allowed.', nil, MB_OK); - InputValid := false; - exit; - end; - if ButtonEdit.Item.Parent = nil then - Key := IniFile.Delimiter - else - Key := ButtonEdit.Item.Parent.GetFullName(IniFile.Delimiter) + IniFile.Delimiter; - - if IniFile.KeyExists(Key + Text) or IniFile.ValueExists(Key, Text) then - begin - MessageBox(0, 'Key/value with the name entered already exists.', nil, MB_OK); - InputValid := false; - exit; - end; - end; -end; - -procedure TMainForm.SpinEditAfterOperation(Sender: TObject; - var Accepted, DefaultConversion: Boolean); -var Key : string; -begin - if SpinEdit.Item.Parent = nil then - Key := IniFile.Delimiter - else - Key := SpinEdit.Item.Parent.GetFullName(IniFile.Delimiter)+IniFile.Delimiter; - - Accepted := IniFile.WriteInteger(Key, SpinEdit.Item.Text, SpinEdit.Editor.Value); - DefaultConversion := true; - FAction := -1; - Modified := true; -end; - -procedure TMainForm.MemoEditAfterOperation(Sender: TObject; - var Accepted, DefaultConversion: Boolean); -var Key : string; -begin - if MemoEdit.Item.Parent = nil then - Key := IniFile.Delimiter - else - Key := MemoEdit.Item.Parent.GetFullName(IniFile.Delimiter)+IniFile.Delimiter; - - Accepted := IniFile.WriteMultiString(Key, MemoEdit.Item.Text, MemoEdit.Editor.Lines); - DefaultConversion := true; - FAction := -1; - Modified := true; -end; - -procedure TMainForm.ButtonEditAfterOperation(Sender: TObject; - var Accepted, DefaultConversion: Boolean); -var Text : string; - Key : string; - FOldKey: string; -begin - if Accepted then - begin - Text := ButtonEdit.Editor.Text; - if ButtonEdit.Item.Parent = nil then - Key := IniFile.Delimiter - else - Key := ButtonEdit.Item.Parent.GetFullName(IniFile.Delimiter)+IniFile.Delimiter; - - if Accepted then - begin - case FAction of - 0: // create a key - begin - FOldKey := IniFile.CurrentKey; - Accepted := IniFile.OpenKey(Key + Text, true); - IniFile.OpenKey(FOldKey, false); - end; - 1: // create a value - Accepted := IniFile.CreateValue(Key, Text) <> nil; - 2: // rename a key - Accepted := IniFile.RenameKey(Key + ButtonEdit.Item.Text, Text); - 3: // rename a value - Accepted := IniFile.RenameValue(Key, ButtonEdit.Item.Text, Text); - 4: // edit value - Accepted := IniFile.WriteString(Key, ButtonEdit.Item.Text, Text); - end; - end; - if Accepted and (FAction = 1) then - IniFile.SetValueType(Key, Text, TElValueType(integer(ButtonEdit.Item.Data) shr 1)); - - SetItemStyles(ButtonEdit.Item); - end; - FAction := -1; - Modified := true; -end; - -procedure TMainForm.ButtonEditBeforeOperation(Sender: TObject; - var DefaultConversion: Boolean); -begin - ButtonEdit.Editor.ButtonVisible := false; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/frmMstrEdit.dfm b/sdk/components/ElPack/BCBDemos/IniEdit/frmMstrEdit.dfm deleted file mode 100644 index 60f9b2ca957..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/IniEdit/frmMstrEdit.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/IniEdit/frmMstrEdit.pas b/sdk/components/ElPack/BCBDemos/IniEdit/frmMstrEdit.pas deleted file mode 100644 index 9b551781808..00000000000 --- a/sdk/components/ElPack/BCBDemos/IniEdit/frmMstrEdit.pas +++ /dev/null @@ -1,28 +0,0 @@ -unit frmMstrEdit; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ElPopBtn, StdCtrls, ElBtnCtl, ElACtrls; - -type - TMStrEditForm = class(TForm) - OkBtn: TElPopupButton; - CancelBtn: TElPopupButton; - MStrMemo: TElFlatMemo; - private - { Private declarations } - public - { Public declarations } - end; - -var - MStrEditForm: TMStrEditForm; - -implementation - -{$R *.DFM} - -end. - diff --git a/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.bpr b/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.bpr deleted file mode 100644 index b775b4e31ce..00000000000 --- a/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.bpr +++ /dev/null @@ -1,183 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = OwnerDraw.exe -OBJFILES = Unit1.obj OwnerDraw.obj -RESFILES = -DEFFILE = -RESDEPEN = $(RESFILES) Unit1.dfm -LIBFILES = -LIBRARIES = VCL35.lib -SPARELIBS = VCL35.lib -PACKAGES = -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -O2 -Hc -w -Ve -k- -vi -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl \ - -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -$L- -$D- -v \ - -JPHN -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 \ - /zn /d_RTLDLL -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -aa -Tpe -x -Gn -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mt.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[HistoryLists\hlIncludePath] -Count=2 -Item0=$(BCB)\include;$(BCB)\include\vcl;E:\projects\ElPack\Code\Source -Item1=$(BCB)\include;$(BCB)\include\vcl - -[HistoryLists\hlLibraryPath] -Count=3 -Item0=..\ownerdraw;..\..\elpack\lib;$(BCB)\lib\obj;$(BCB)\lib;E:\projects\ElPack\Code\Source -Item1=..\ownerdraw;..\..\elpack\lib;$(BCB)\lib\obj;$(BCB)\lib -Item2=..\..\elpack\lib;$(BCB)\lib\obj;$(BCB)\lib - -[HistoryLists\hlDebugSourcePath] -Count=2 -Item0=$(BCB)\source\vcl;E:\projects\ElPack\Code\Source -Item1=$(BCB)\source\vcl - -[HistoryLists\hlConditionals] -Count=2 -Item0=_RTLDLL -Item1=_RTLDLL;USEPACKAGES - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl;E:\projects\ElPack\Code\Source - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.cpp b/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.cpp deleted file mode 100644 index 6a810670b1f..00000000000 --- a/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.cpp +++ /dev/null @@ -1,20 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USEFORMNS("Unit1.pas", Unit1, Form1); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->CreateForm(__classid(TForm1), &Form1); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.res b/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.res deleted file mode 100644 index 1993f343f7b..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/OwnerDraw/OwnerDraw.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/OwnerDraw/Unit1.dfm b/sdk/components/ElPack/BCBDemos/OwnerDraw/Unit1.dfm deleted file mode 100644 index b85f0f9db18..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/OwnerDraw/Unit1.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/OwnerDraw/Unit1.pas b/sdk/components/ElPack/BCBDemos/OwnerDraw/Unit1.pas deleted file mode 100644 index 8f9497f2c79..00000000000 --- a/sdk/components/ElPack/BCBDemos/OwnerDraw/Unit1.pas +++ /dev/null @@ -1,72 +0,0 @@ -unit Unit1; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ElTree, StdCtrls, ElHeader, ElXPThemedControl; - -type - TForm1 = class(TForm) - ElTree1: TElTree; - ElTree2: TElTree; - Label1: TLabel; - Label2: TLabel; - procedure FormShow(Sender: TObject); - procedure ElTree1ItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); - procedure ElTree2ItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); - procedure ElTree1HeaderColumnDraw(Sender: TCustomElHeader; - Canvas: TCanvas; Section: TElHeaderSection; R: TRect; - Pressed: Boolean); - private - { Private declarations } - public - { Public declarations } - end; - -var - Form1: TForm1; - -implementation - -{$R *.DFM} - -procedure TForm1.FormShow(Sender: TObject); -var TI : TElTreeItem; - CS : TElCellStyle; -begin - TI := ElTree2.Items[0]; - TI.UseStyles := true; - CS := TI.AddStyle; - CS.OwnerProps := true; - CS.Style := elhsOwnerDraw; -end; - -procedure TForm1.ElTree1ItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); -begin - Surface.Brush.Style := bsClear; - DrawText(Surface.Handle, 'Owner-drawn cell', -1, R, DT_SINGLELINE or DT_CENTER); -end; - -procedure TForm1.ElTree2ItemDraw(Sender: TObject; Item: TElTreeItem; - Surface: TCanvas; R: TRect; SectionIndex: Integer); -begin - Surface.Brush.Style := bsClear; - if Item.StylesCount > 0 then - DrawText(Surface.Handle, 'Owner-draw style defined by ElCellStyle', -1, R, DT_SINGLELINE or DT_LEFT) - else - DrawText(Surface.Handle, PChar(Format('cell #%d, Item #%d', [SectionIndex, Item.AbsoluteIndex])), -1, R, DT_SINGLELINE or DT_CENTER); -end; - -procedure TForm1.ElTree1HeaderColumnDraw(Sender: TCustomElHeader; - Canvas: TCanvas; Section: TElHeaderSection; R: TRect; Pressed: Boolean); -begin - Canvas.Brush.Style := bsClear; - DrawText(Canvas.Handle, 'Owner-drawn section', -1, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER); -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/Pinger/About.dfm b/sdk/components/ElPack/BCBDemos/Pinger/About.dfm deleted file mode 100644 index 074be1767bc..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/Pinger/About.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/Pinger/About.pas b/sdk/components/ElPack/BCBDemos/Pinger/About.pas deleted file mode 100644 index 3f2f2cc7e19..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/About.pas +++ /dev/null @@ -1,29 +0,0 @@ -unit About; - -interface - -uses Windows, Classes, Forms, Controls, StdCtrls, Buttons, ExtCtrls, ElURLLabel, - Graphics, ElCLabel; - -type - TAboutBox = class(TForm) - Panel1: TPanel; - OKButton: TButton; - ProductName: TLabel; - Copyright: TLabel; - Image1: TImage; - HomeLabel: TElURLLabel; - MailLabel: TElURLLabel; - Label3: TLabel; - ElPackLabel: TElURLLabel; - end; - -var - AboutBox: TAboutBox; - -implementation - -{$R *.DFM} - -end. - diff --git a/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.bpr b/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.bpr deleted file mode 100644 index 881a2ae130c..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.bpr +++ /dev/null @@ -1,159 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = ElPinger.exe -OBJFILES = MAIN.obj About.obj frmList.obj frmProp.obj ICMP.obj PingThread.obj SiteMan.obj \ - ElPinger.obj -RESFILES = ElPinger.res -DEFFILE = -RESDEPEN = $(RESFILES) MAIN.dfm About.dfm frmList.dfm frmProp.dfm -LIBFILES = -LIBRARIES = -SPARELIBS = VCL35.lib -PACKAGES = -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -Od -Hc -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl -D_RTLDLL;USEPACKAGES -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -$Y -$W -$O- -v -JPHN -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zd -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) -aa -Tpe -x -Gn -v -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj $(PACKAGES) sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.cpp b/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.cpp deleted file mode 100644 index e8f0b999a42..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.cpp +++ /dev/null @@ -1,32 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("ElPinger.res"); -USEFORMNS("MAIN.PAS", Main, MainForm); -USEFORMNS("About.pas", About, AboutBox); -USEFORMNS("frmList.pas", Frmlist, SitesForm); -USEFORMNS("frmProp.pas", Frmprop, PropForm); -USEUNIT("ICMP.pas"); -USEUNIT("PingThread.pas"); -USEUNIT("SiteMan.pas"); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { -// Application->Initialize(); - Application->Title = "EldoS Pinger"; - FreeLibrary(GetModuleHandle("OleAut32")); - Application->CreateForm(__classid(TMainForm), &MainForm); - Application->CreateForm(__classid(TSitesForm), &SitesForm); - Application->CreateForm(__classid(TPropForm), &PropForm); - Application->CreateForm(__classid(TAboutBox), &AboutBox); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.res b/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.res deleted file mode 100644 index bae5442ae6b..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/Pinger/ElPinger.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/Pinger/ICMP.pas b/sdk/components/ElPack/BCBDemos/Pinger/ICMP.pas deleted file mode 100644 index afa9b66ad6f..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/ICMP.pas +++ /dev/null @@ -1,438 +0,0 @@ -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * - -Author: François PIETTE -Description: This unit encapsulate the ICMP.DLL into an object of type TICMP. - Using this object, you can easily ping any host on your network. - Works only in 32 bits mode (no Delphi 1) under NT or 95. - TICMP is perfect for a console mode program, but if you build a - GUI program, you could use the TPing object wich is a true VCL - encapsulating the TICMP object. Then you can use object inspector - to change properties or event handler. This is much simpler to - use for a GUI program. -EMail: francois.piette@ping.be http://www.rtfm.be/fpiette - francois.piette@rtfm.be -Creation: January 6, 1997 -Version: 1.02 -WebSite: http://www.rtfm.be/fpiette/indexuk.htm -Support: Use the mailing list twsocket@rtfm.be See website for details. -Legal issues: Copyright (C) 1997 by François PIETTE - - This software is provided 'as-is', without any express or - implied warranty. In no event will the author be held liable - for any damages arising from the use of this software. - - Permission is granted to anyone to use this software for any - purpose, including commercial applications, and to alter it - and redistribute it freely, subject to the following - restrictions: - - 1. The origin of this software must not be misrepresented, - you must not claim that you wrote the original software. - If you use this software in a product, an acknowledgment - in the product documentation would be appreciated but is - not required. - - 2. Altered source versions must be plainly marked as such, and - must not be misrepresented as being the original software. - - 3. This notice may not be removed or altered from any source - distribution. - -Updates: -Dec 13, 1997 V1.01 Added OnEchoRequest and OnEchoReply events and removed the - corresponding OnDisplay event. This require to modify existing - programs. -Mar 15, 1998 V1.02 Deplaced address resolution just before use - - - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -unit icmp; - -interface - -{$IFDEF VER80} -// This source file is *NOT* compatible with Delphi 1 because it uses -// Win 32 features. -{$ENDIF} - -uses - Windows, SysUtils, Classes, WinSock; - -const - IcmpVersion = 102; - IcmpDLL = 'icmp.dll'; - - // IP status codes returned to transports and user IOCTLs. - IP_SUCCESS = 0; - IP_STATUS_BASE = 11000; - IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1); - IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2); - IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3); - IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4); - IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5); - IP_NO_RESOURCES = (IP_STATUS_BASE + 6); - IP_BAD_OPTION = (IP_STATUS_BASE + 7); - IP_HW_ERROR = (IP_STATUS_BASE + 8); - IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9); - IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10); - IP_BAD_REQ = (IP_STATUS_BASE + 11); - IP_BAD_ROUTE = (IP_STATUS_BASE + 12); - IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13); - IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14); - IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15); - IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16); - IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17); - IP_BAD_DESTINATION = (IP_STATUS_BASE + 18); - - // status codes passed up on status indications. - IP_ADDR_DELETED = (IP_STATUS_BASE + 19); - IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20); - IP_MTU_CHANGE = (IP_STATUS_BASE + 21); - - IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50); - - MAX_IP_STATUS = IP_GENERAL_FAILURE; - - IP_PENDING = (IP_STATUS_BASE + 255); - - // IP header flags - IP_FLAG_DF = $02; // Don't fragment this packet. - - // IP Option Types - IP_OPT_EOL = $00; // End of list option - IP_OPT_NOP = $01; // No operation - IP_OPT_SECURITY = $82; // Security option. - IP_OPT_LSRR = $83; // Loose source route. - IP_OPT_SSRR = $89; // Strict source route. - IP_OPT_RR = $07; // Record route. - IP_OPT_TS = $44; // Timestamp. - IP_OPT_SID = $88; // Stream ID (obsolete) - MAX_OPT_SIZE = $40; - -type - // IP types - TIPAddr = DWORD; // An IP address. - TIPMask = DWORD; // An IP subnet mask. - TIPStatus = DWORD; // Status code returned from IP APIs. - - PIPOptionInformation = ^TIPOptionInformation; - TIPOptionInformation = packed record - TTL: Byte; // Time To Live (used for traceroute) - TOS: Byte; // Type Of Service (usually 0) - Flags: Byte; // IP header flags (usually 0) - OptionsSize: Byte; // Size of options data (usually 0, max 40) - OptionsData: PChar; // Options data buffer - end; - - PIcmpEchoReply = ^TIcmpEchoReply; - TIcmpEchoReply = packed record - Address: TIPAddr; // Replying address - Status: DWord; // IP status value - RTT: DWord; // Round Trip Time in milliseconds - DataSize: Word; // Reply data size - Reserved: Word; // Reserved - Data: Pointer; // Pointer to reply data buffer - Options: TIPOptionInformation; // Reply options - end; - - // IcmpCreateFile: - // Opens a handle on which ICMP Echo Requests can be issued. - // Arguments: - // None. - // Return Value: - // An open file handle or INVALID_HANDLE_VALUE. Extended error information - // is available by calling GetLastError(). - TIcmpCreateFile = function: THandle; stdcall; - - // IcmpCloseHandle: - // Closes a handle opened by ICMPOpenFile. - // Arguments: - // IcmpHandle - The handle to close. - // Return Value: - // TRUE if the handle was closed successfully, otherwise FALSE. Extended - // error information is available by calling GetLastError(). - TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall; - - // IcmpSendEcho: - // Sends an ICMP Echo request and returns one or more replies. The - // call returns when the timeout has expired or the reply buffer - // is filled. - // Arguments: - // IcmpHandle - An open handle returned by ICMPCreateFile. - // DestinationAddress - The destination of the echo request. - // RequestData - A buffer containing the data to send in the - // request. - // RequestSize - The number of bytes in the request data buffer. - // RequestOptions - Pointer to the IP header options for the request. - // May be NULL. - // ReplyBuffer - A buffer to hold any replies to the request. - // On return, the buffer will contain an array of - // ICMP_ECHO_REPLY structures followed by options - // and data. The buffer should be large enough to - // hold at least one ICMP_ECHO_REPLY structure - // and 8 bytes of data - this is the size of - // an ICMP error message. - // ReplySize - The size in bytes of the reply buffer. - // Timeout - The time in milliseconds to wait for replies. - // Return Value: - // Returns the number of replies received and stored in ReplyBuffer. If - // the return value is zero, extended error information is available - // via GetLastError(). - TIcmpSendEcho = function(IcmpHandle: THandle; - DestinationAddress: TIPAddr; - RequestData: Pointer; - RequestSize: Word; - RequestOptions: PIPOptionInformation; - ReplyBuffer: Pointer; - ReplySize: DWord; - Timeout: DWord - ): DWord; stdcall; - - // Event handler type declaration for TICMP.OnDisplay event. - TICMPDisplay = procedure(Sender: TObject; Msg : String) of object; - TICMPReply = procedure(Sender: TObject; Error : Integer) of object; - - // The object wich encapsulate the ICMP.DLL - TICMP = class(TObject) - private - hICMPdll : HModule; // Handle for ICMP.DLL - IcmpCreateFile : TIcmpCreateFile; - IcmpCloseHandle : TIcmpCloseHandle; - IcmpSendEcho : TIcmpSendEcho; - hICMP : THandle; // Handle for the ICMP Calls - FReply : TIcmpEchoReply; // ICMP Echo reply buffer - FAddress : String; // Address given - FHostName : String; // Dotted IP of host (output) - FHostIP : String; // Name of host (Output) - FIPAddress : TIPAddr; // Address of host to contact - FSize : Integer; // Packet size (default to 56) - FTimeOut : Integer; // Timeout (default to 4000mS) - FTTL : Integer; // Time To Live (for send) - FOnDisplay : TICMPDisplay; // Event handler to display - FOnEchoRequest : TNotifyEvent; - FOnEchoReply : TICMPReply; - FLastError : DWORD; // After sending ICMP packet - FAddrResolved : Boolean; - public - constructor Create; virtual; - destructor Destroy; override; - function Ping : Integer; - procedure SetAddress(Value : String); - function GetErrorString : String; - procedure ResolveAddr; - - property Address : String read FAddress write SetAddress; - property Size : Integer read FSize write FSize; - property Timeout : Integer read FTimeout write FTimeout; - property Reply : TIcmpEchoReply read FReply; - property TTL : Integer read FTTL write FTTL; - property ErrorCode : DWORD read FLastError; - property ErrorString : String read GetErrorString; - property HostName : String read FHostName; - property HostIP : String read FHostIP; - property OnDisplay : TICMPDisplay read FOnDisplay write FOnDisplay; - property OnEchoRequest : TNotifyEvent read FOnEchoRequest - write FOnEchoRequest; - property OnEchoReply : TICMPReply read FOnEchoReply - write FOnEchoReply; - end; - - TICMPException = class(Exception); - -implementation - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -constructor TICMP.Create; -var - WSAData: TWSAData; -begin - hICMP := INVALID_HANDLE_VALUE; - FSize := 56; - FTTL := 64; - FTimeOut := 4000; - - // initialise winsock - if WSAStartup($101, WSAData) <> 0 then - raise TICMPException.Create('Error initialising Winsock'); - - // register the icmp.dll stuff - hICMPdll := LoadLibrary(icmpDLL); - if hICMPdll = 0 then - raise TICMPException.Create('Unable to register ' + icmpDLL); - - @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile'); - @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle'); - @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho'); - - if (@ICMPCreateFile = Nil) or - (@IcmpCloseHandle = Nil) or - (@IcmpSendEcho = Nil) then - raise TICMPException.Create('Error loading dll functions'); - - hICMP := IcmpCreateFile; - if hICMP = INVALID_HANDLE_VALUE then - raise TICMPException.Create('Unable to get ping handle'); -end; - - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -destructor TICMP.Destroy; -begin - if hICMP <> INVALID_HANDLE_VALUE then - IcmpCloseHandle(hICMP); - if hICMPdll <> 0 then - FreeLibrary(hICMPdll); - WSACleanup; - inherited Destroy; -end; - - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -function MinInteger(X, Y: Integer): Integer; -begin - if X >= Y then - Result := Y - else - Result := X; -end; - - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -procedure TICMP.ResolveAddr; -var - Phe : PHostEnt; // HostEntry buffer for name lookup -begin - // Convert host address to IP address - FIPAddress := inet_addr(PChar(FAddress)); - if FIPAddress <> INADDR_NONE then - // Was a numeric dotted address let it in this format - FHostName := FAddress - else begin - // Not a numeric dotted address, try to resolve by name - Phe := GetHostByName(PChar(FAddress)); - if Phe = nil then begin - FLastError := GetLastError; - if Assigned(FOnDisplay) then - FOnDisplay(Self, 'Unable to resolve ' + FAddress); - Exit; - end; - - FIPAddress := longint(plongint(Phe^.h_addr_list^)^); - FHostName := Phe^.h_name; - end; - - FHostIP := StrPas(inet_ntoa(TInAddr(FIPAddress))); - FAddrResolved := TRUE; -end; - - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -procedure TICMP.SetAddress(Value : String); -begin - // Only change if needed (could take a long time) - if FAddress = Value then - Exit; - FAddress := Value; - FAddrResolved := FALSE; -// ResolveAddr; -end; - - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -function TICMP.GetErrorString : String; -begin - case FLastError of - IP_SUCCESS: Result := 'No error'; - IP_BUF_TOO_SMALL: Result := 'Buffer too small'; - IP_DEST_NET_UNREACHABLE: Result := 'Destination network unreachable'; - IP_DEST_HOST_UNREACHABLE: Result := 'Destination host unreachable'; - IP_DEST_PROT_UNREACHABLE: Result := 'Destination protocol unreachable'; - IP_DEST_PORT_UNREACHABLE: Result := 'Destination port unreachable'; - IP_NO_RESOURCES: Result := 'No resources'; - IP_BAD_OPTION: Result := 'Bad option'; - IP_HW_ERROR: Result := 'Hardware error'; - IP_PACKET_TOO_BIG: Result := 'Packet too big'; - IP_REQ_TIMED_OUT: Result := 'Request timed out'; - IP_BAD_REQ: Result := 'Bad request'; - IP_BAD_ROUTE: Result := 'Bad route'; - IP_TTL_EXPIRED_TRANSIT: Result := 'TTL expired in transit'; - IP_TTL_EXPIRED_REASSEM: Result := 'TTL expired in reassembly'; - IP_PARAM_PROBLEM: Result := 'Parameter problem'; - IP_SOURCE_QUENCH: Result := 'Source quench'; - IP_OPTION_TOO_BIG: Result := 'Option too big'; - IP_BAD_DESTINATION: Result := 'Bad Destination'; - IP_ADDR_DELETED: Result := 'Address deleted'; - IP_SPEC_MTU_CHANGE: Result := 'Spec MTU change'; - IP_MTU_CHANGE: Result := 'MTU change'; - IP_GENERAL_FAILURE: Result := 'General failure'; - IP_PENDING: Result := 'Pending'; - else - Result := 'ICMP error #' + IntToStr(FLastError); - end; -end; - - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} -function TICMP.Ping : Integer; -var - BufferSize: Integer; - pReqData, pData: Pointer; - pIPE: PIcmpEchoReply; // ICMP Echo reply buffer - IPOpt: TIPOptionInformation; // IP Options for packet to send - Msg: String; -begin - Result := 0; - FLastError := 0; - - if not FAddrResolved then - ResolveAddr; - - if FIPAddress = INADDR_NONE then begin - FLastError := IP_BAD_DESTINATION; - if Assigned(FOnDisplay) then - FOnDisplay(Self, 'Invalid host address'); - Exit; - end; - - // Allocate space for data buffer space - BufferSize := SizeOf(TICMPEchoReply) + FSize; - GetMem(pReqData, FSize); - GetMem(pData, FSize); - GetMem(pIPE, BufferSize); - - try - // Fill data buffer with some data bytes - FillChar(pReqData^, FSize, $20); - Msg := 'Pinging from Delphi code written by F. Piette'; - Move(Msg[1], pReqData^, MinInteger(FSize, Length(Msg))); - - pIPE^.Data := pData; - FillChar(pIPE^, SizeOf(pIPE^), 0); - - if Assigned(FOnEchoRequest) then - FOnEchoRequest(Self); - - FillChar(IPOpt, SizeOf(IPOpt), 0); - IPOpt.TTL := FTTL; - Result := IcmpSendEcho(hICMP, FIPAddress, pReqData, FSize, - @IPOpt, pIPE, BufferSize, FTimeOut); - FLastError := GetLastError; - FReply := pIPE^; - - if Assigned(FOnEchoReply) then - FOnEchoReply(Self, Result); - finally - // Free those buffers - FreeMem(pIPE); - FreeMem(pData); - FreeMem(pReqData); - end; -end; - - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} - -end. - -{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} - diff --git a/sdk/components/ElPack/BCBDemos/Pinger/MAIN.PAS b/sdk/components/ElPack/BCBDemos/Pinger/MAIN.PAS deleted file mode 100644 index f1c20925e8e..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/MAIN.PAS +++ /dev/null @@ -1,339 +0,0 @@ -unit Main; - -interface - -uses - SysUtils, Windows, Messages, Classes, Graphics, Controls, - Forms, Dialogs, StdCtrls, ExtCtrls, Menus, ComCtrls, ElInputDlg, - ICMP, ElGraphs, SiteMan, ElTools, ElIni, ElFrmPers, ElTimers, ElPgCtl, - ElXPThemedControl, ElStatBar; - -type - TMainForm = class(TForm) - MainMenu: TMainMenu; - GraphAddItem: TMenuItem; - GraphRemoveItem: TMenuItem; - FileExitItem: TMenuItem; - HelpAboutItem: TMenuItem; - PropItem: TMenuItem; - ResetItem: TMenuItem; - ElFormPersist1: TElFormPersist; - ElIniFile1: TElIniFile; - TimerList: TElTimerPool; - Pages: TElPageControl; - StatusBar: TElStatusBar; - procedure FileExit(Sender: TObject); - procedure HelpAbout(Sender: TObject); - procedure GraphAddItemClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure GraphRemoveItemClick(Sender: TObject); - procedure PropItemClick(Sender: TObject); - procedure PagesChange(Sender: TObject); - procedure FileMenuClick(Sender: TObject); - procedure ResetItemClick(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - protected - SiteList : TList; - ShutDown : boolean; - function DoAddGraph(HostName:string) : TSite; - procedure LoadList; - procedure SaveList; - public - procedure Loaded ; override ; - end; - -var - MainForm: TMainForm; - -implementation - -uses frmList, About, frmProp; - -{$R *.DFM} - -procedure TMainForm.FileExit(Sender: TObject); -var i:integer; -begin - for i:=0 to SiteList.Count-1 do TSite(SiteList[i]).Shutdown:=true; - MainForm.Close; -end; - -procedure TMainForm.HelpAbout(Sender: TObject); -begin - AboutBox.ShowModal; -end; - -procedure TMainForm.GraphAddItemClick(Sender: TObject); -var S:String; -begin - Application.ProcessMessages; - S := ''; - if ElInputDlg.InputQuery('Add host to ping','Please enter the host name or address to ping', S, false) then - begin - if DoAddGraph(S) <> nil then - begin - PropItemClick(Self); - end; - end; -end; - -function TMainForm.DoAddGraph; -var S:String; - IC:TICMP; - Site : TSite; - Entry : TDataEntry; -begin - result := nil; - S:=HostName; - try - IC:=TICMP.Create; - except - On E:TICMPException do - begin - MessageBox(0,PChar(E.Message),PChar(Application.Title),MB_ICONSTOP or MB_OK); - exit; - end; - end; - IC.Address:=S; - IC.ResolveAddr; - if IC.ErrorCode > 0 then - begin - MessageBox(0,'Failed to resolve the given address',PChar(Application.Title),MB_ICONSTOP or MB_OK); - IC.Free; - Exit; - end; - Site := TSite.Create; - SiteList.Add(Site); - Site.Address := IC.HostIP; - IC.Free; - Site.RepCount := 0; - Site.HostName:=S; - Site.Timeout := 1000; - Site.StartTime:=DateTimeToStr(Now); - Site.Sheet:=TElTabSheet.Create(Pages); - Site.Sheet.PageControl:=Pages; - Site.Graph:=TElGraph.Create(Site.Sheet); - Site.Sheet.InsertControl(Site.Graph); - Site.Graph.Align:=alClient; - Site.Sheet.Caption:=Site.HostName; - Entry:=Site.Graph.AddEntry; - Site.Graph.ShowMinMax:=true; - Site.Graph.ShowLegend:=false; - Site.Graph.ColumnEntry:=Entry; - Site.Graph.MinMaxEntry:=Entry; - Site.Graph.ShowGrid:=false; - Site.Graph.HGridLines:=5; - Site.Graph.VGridLines:=20; - Site.Graph.Color:=clBtnText; - Site.Graph.LegendBkColor:=clWindow; - Entry.Color:=clLime; - Entry.MaxGrid:=100; - Entry.AutoGrid:=true; - Site.Start; - Pages.ActivePage := Site.Sheet; - PagesChange(Self); - Result := Site; -end; - -procedure TMainForm.FormDestroy(Sender: TObject); -var i:integer; - Site: TSite; -begin - ShutDown:=true; - Screen.Cursor := crHourGlass; - try - i:=0; - while i0 then - begin - Pages.ActivePage := Pages.Pages[0]; - PagesChange(Self); - end else StatusBar.SimpleText := ''; - end; -end; - -procedure TMainForm.PropItemClick(Sender: TObject); -var Sheet : TElTabSheet; - i : integer; - Site : TSite; -begin - Sheet:=Pages.ActivePage; - if Sheet = nil then exit; - i:=0; - while TSite(SiteList[i]).Sheet<>Sheet do inc(i); - if i>=SiteList.Count then exit; - Site:=TSite(SiteList[i]); - PropForm.HostLabel.Caption:=Site.Address; - PropForm.GridCB.Checked:=Site.Graph.ShowGrid; - PropForm.TimeOutSpin.Value:=Site.Timeout; - PropForm.LogCountSpin.Value:=Site.RepCount; - PropForm.IntervalSpin.Value := Site.Interval; - PropForm.RepCB.Checked:= Site.RepCount>0; - PropForm.LogNameEdit.Text:=Site.RepFile; - PropForm.LogNameEdit.Enabled := Site.RepCount>0; - if PropForm.ShowModal = mrCancel then exit; - Site.Timeout:=Trunc(PropForm.TimeOutSpin.Value); - Site.Interval := Trunc(PropForm.IntervalSpin.Value); - Site.Graph.ShowGrid:=PropForm.GridCB.Checked; - Site.RepFile:=PropForm.LogNameEdit.Text; - if not PropForm.RepCB.Checked - then Site.RepCount:= 0 - else Site.RepCount:= Round(PropForm.LogCountSpin.Value); -end; - -procedure TMainForm.Loaded ; { public } -var i:integer; -begin - SiteList:=TList.Create; - for i:=1 to ParamCount do // Iterate - DoAddGraph(ParamStr(i)); - LoadList; -end ; { Loaded } - -procedure TMainForm.PagesChange(Sender: TObject); -var Site : TSite; - i : integer; - Sheet : TElTabSheet; - -begin - i:=0; - Sheet := Pages.ActivePage; - if Sheet = nil then - begin - StatusBar.SimpleText := ''; - exit; - end; - if SiteList.Count < i then exit; - while TSite(SiteList[i]).Sheet<>Sheet do inc(i); - Site:=TSite(SiteList[i]); - StatusBar.SimpleText := 'Started '+ Site.StartTime; -end; - -procedure TMainForm.FileMenuClick(Sender: TObject); -begin - GraphRemoveItem.Enabled := Pages.ActivePage <> nil; - PropItem.Enabled := Pages.ActivePage <> nil; - ResetItem.Enabled := Pages.ActivePage <> nil; -end; - -procedure TMainForm.ResetItemClick(Sender: TObject); -var Sheet : TElTabSheet; - i : integer; - Site : TSite; - -begin - Sheet := Pages.ActivePage; - if Sheet = nil then exit; - if MessageBox(0, 'Reset statistics???', PChar(Application.Title), mb_YesNo) = mrNo then exit; - i := 0; - while TSite(SiteList[i]).Sheet<>Sheet do inc(i); - Site:=TSite(SiteList[i]); - Site.Graph.MinMaxEntry.Reset; - Site.StartTime:=DateTimeToStr(Now); - StatusBar.SimpleText := Site.StartTime; -end; - -procedure TMainForm.LoadList; { protected } -var S : TFileStream; - i, j, - k : integer; - Site : TSite; - host : string; - aFile : String; -begin - try - aFile := ExtractFilePath(ParamStr(0))+'ElPinger.hst'; - if FileExists(aFile) then - begin - S := TFileStream.Create(aFile, fmOpenRead or fmShareDenyWrite); - try - S.ReadBuffer(i, sizeof(Integer)); - for j := 0 to i - 1 do - begin - if (not ReadStringFromStream(S, Host)) or (Host = '') then Continue; - Site := DoAddGraph(Host); - if Site = nil then Continue; - if ReadStringFromStream(S, Host) then Site.RepFile := Host; - ReadStringFromStream(S, Site.StartTime); - StatusBar.SimpleText := 'Started '+ Site.StartTime; - S.ReadBuffer(K, sizeof(Integer)); - Site.Timeout := K; - S.ReadBuffer(K, sizeof(Integer)); - Site.RepCount := K; - S.ReadBuffer(K, sizeof(Integer)); - Site.Interval := K; - end; - finally - S.Free; - end; - end; - except - end; -end; { LoadList } - -procedure TMainForm.SaveList; { protected } -var S : TFileStream; - i, j : integer; - Site : TSite; - -begin - S := nil; - try - S := TFileStream.Create(ExtractFilePath(ParamStr(0))+'ElPinger.hst', fmCreate or fmShareDenyWrite); - i := SiteList.Count; - S.WriteBuffer(i, sizeof(Integer)); - for j := 0 to i - 1 do - begin - Site := TSite(SiteList[j]); - WriteStringToStream(S, Site.HostName); - WriteStringToStream(S, Site.RepFile); - WriteStringToStream(S, Site.StartTime); - S.WriteBuffer(Site.Timeout, sizeof(Integer)); - S.WriteBuffer(Site.RepCount, sizeof(Integer)); - S.WriteBuffer(Site.Interval, sizeof(Integer)); - end; - finally - S.Free; - end; -end; { SaveList } - -procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); -begin - SaveList; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/Pinger/MAIN.dfm b/sdk/components/ElPack/BCBDemos/Pinger/MAIN.dfm deleted file mode 100644 index 2b95b2344fe..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/Pinger/MAIN.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/Pinger/PingThread.pas b/sdk/components/ElPack/BCBDemos/Pinger/PingThread.pas deleted file mode 100644 index ecc56c91c95..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/PingThread.pas +++ /dev/null @@ -1,57 +0,0 @@ -unit PingThread; - -interface - -uses - Windows, Classes, ElGraphs, ICMP, SiteMan, SysUtils; - -type - TPingThread = class(TThread) - private - res : integer; - protected - procedure Execute; override; - procedure Report; - public - Address : string; - Timeout : integer; - DataSize : integer; - Graph : TElGraph; - Site : TSite; - - property Terminated; - end; - -implementation - -{ TPingThread } - -procedure TPingThread.Report; -begin - Graph.DataList[0].AddValue(res); - Site.SaveValue; - Graph.Repaint; -end; - -procedure TPingThread.Execute; -var xPing: TICMP; -begin - xPing := nil; - try - try - xPing:=TICMP.Create; - xPing.Address := Address; - xPing.Timeout := Timeout; - xPing.Size := DataSize; - res:=xPing.Ping; - if (res<>0) then res := xPing.Reply.RTT else res:=-1; - Synchronize(report); - finally - xPing.Free; - end; - except - on E : Exception do ; - end; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/Pinger/SiteMan.pas b/sdk/components/ElPack/BCBDemos/Pinger/SiteMan.pas deleted file mode 100644 index a56ac202d61..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/SiteMan.pas +++ /dev/null @@ -1,149 +0,0 @@ -unit SiteMan; - -interface - -uses ElGraphs, ExtCtrls, ElPgCtl, Classes, Forms, SysUtils, ElTimers; - -type TSite = class - private - FInterval: integer; - procedure SetInterval(Value : integer); - procedure SetRepCount(Value : integer); - //procedure SetRepFile (Value : string); - public - Shutdown : boolean; - Address : string; - HostName : string; - Timeout : integer; - Graph : TElGraph; - Sheet : TElTabSheet; - StartTime : string; - ThreadList : TList; - Timer : TElTimerPoolItem; - FRepFile : string; - - F : TextFile; - FRepCount, - RepNow : integer; - procedure SaveValue; - procedure Start; - destructor Destroy; override; - procedure TimerProc(Sender:TObject); - procedure OnThreadFinish(Sender:TObject); - - property RepFile : string read FRepFile write FRepFile; - property RepCount : integer read FRepCount write SetRepCount; - property Interval : integer read FInterval write SetInterval; - end; - -implementation - -uses PingThread, Main; - -procedure TSite.SetRepCount(Value : integer); -begin - if (FRepFile <> '') and (Value >0) and (Value <>FRepCount) then - begin - if (FRepCount = 0) then - begin - try - if not FileExists(FRepFile) then - begin - AssignFile(F, FRepFile); - Rewrite(F); - end else - begin - AssignFile(F, FRepFile); - Append(F); - end; - Writeln(F, ''); - Write(F, 'Time: ', DateTimeToStr(Now)); - WriteLn(F, ' EldoS Pinger started logging.'); - CloseFile(F); - except - end; - end; - end; - FRepCount := Value; -end; - -procedure TSite.SetInterval; -var Event : TElTimerPoolItem; -begin - if (Value <> FInterval) and (Value >=500) then - begin - FInterval := Value; - Event := Timer; - Event.Interval := Value; - end; -end; - -procedure TSite.Start; -begin - ThreadList:=TList.Create; - if Interval = 0 then - FInterval := 1000; - Timer := MainForm.TimerList.Items.Add; - Timer.Interval := FInterval; - Timer.OnTimer := TimerProc; - Timer.Enabled := true; -end; - -destructor TSite.Destroy; -begin - Timer.Free; - - while ThreadList.Count >0 do - Application.ProcessMessages; - - ThreadList.Free; - inherited; -end; - -procedure TSite.OnThreadFinish(Sender:TObject); -begin - ThreadList.Remove(Sender); -end; - -procedure TSite.TimerProc; -var Thread : TPingThread; -begin - if Shutdown then exit; - Thread := TPingThread.Create(true); - Thread.Address:=Address; - Thread.Graph:=Graph; - Thread.Site := Self; - Thread.Timeout := Timeout; - Thread.FreeOnTerminate:=true; - Thread.OnTerminate:=OnThreadFinish; - ThreadList.Add(Thread); - Thread.Resume; -end; - -procedure TSite.SaveValue; { public } -var Min, - Max, - Avg : integer; -begin - if (RepCount = 0) or (RepFile = '') then exit; - inc (RepNow); - if RepNow >= RepCount then - begin - RepNow := 0; - try - AssignFile(F, RepFile); - Append(F); - Write(F, 'Time: ', DateTimeToStr(Now)); - Write(F, ' Faults: ', Graph.DataList[0].Faults); - Graph.DataList[0].CalcMinMax(Min, Max, Avg); - Write(F, ' Average: ', Avg); - WriteLn(F, ' Last: ', Graph.DataList[0].Value[Graph.DataList[0].ValueCount-1]); - - CloseFile(F); - except - on E: Exception do ; - end; - end; -end; { SaveValue } - -end. diff --git a/sdk/components/ElPack/BCBDemos/Pinger/frmList.dfm b/sdk/components/ElPack/BCBDemos/Pinger/frmList.dfm deleted file mode 100644 index 57b915e316c..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/Pinger/frmList.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/Pinger/frmList.pas b/sdk/components/ElPack/BCBDemos/Pinger/frmList.pas deleted file mode 100644 index 25cc3849f9e..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/frmList.pas +++ /dev/null @@ -1,41 +0,0 @@ -unit frmList; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElACtrls, ElXPThemedControl, ElBtnCtl, ElPopBtn; - -type - TSitesForm = class(TForm) - Sites: TElAdvancedListBox; - OkBtn: TElPopupButton; - CancelBtn: TElPopupButton; - procedure SitesClick(Sender: TObject); - procedure FormShow(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - SitesForm: TSitesForm; - -implementation - -{$R *.DFM} - - -procedure TSitesForm.SitesClick(Sender: TObject); -begin - OkBtn.Enabled := Sites.ItemIndex <> -1; -end; - -procedure TSitesForm.FormShow(Sender: TObject); -begin - ActiveControl := Sites; - OkBtn.Enabled := Sites.ItemIndex <> -1; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/Pinger/frmProp.dfm b/sdk/components/ElPack/BCBDemos/Pinger/frmProp.dfm deleted file mode 100644 index 1ea03580e96..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/Pinger/frmProp.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/Pinger/frmProp.pas b/sdk/components/ElPack/BCBDemos/Pinger/frmProp.pas deleted file mode 100644 index 80af152c83e..00000000000 --- a/sdk/components/ElPack/BCBDemos/Pinger/frmProp.pas +++ /dev/null @@ -1,52 +0,0 @@ -unit frmProp; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElSpin, Mask, ElFlatCtl, ElBtnCtl, ElCheckCtl, - ElBtnEdit, ElACtrls, ElXPThemedControl, ElPopBtn, ElNameEdits; - -type - TPropForm = class(TForm) - Label1: TLabel; - HostLabel: TLabel; - Label2: TLabel; - Label3: TLabel; - Label4: TLabel; - Label5: TLabel; - Label6: TLabel; - Label7: TLabel; - IntervalSpin: TElSpinEdit; - TimeOutSpin: TElSpinEdit; - LogCountSpin: TElSpinEdit; - GridCB: TElCheckBox; - RepCB: TElCheckBox; - ElFlatController1: TElFlatController; - OkBtn: TElPopupButton; - CancelBtn: TElPopupButton; - LogNameEdit: TElFileNameEdit; - procedure RepCBClick(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - PropForm: TPropForm; - -implementation - -{$R *.DFM} - -procedure TPropForm.RepCBClick(Sender: TObject); -var b : boolean; -begin - b := RepCB.Checked; - LogNameEdit.ReadOnly := not b; - LogNameEdit.Enabled := b; - LogCountSpin.Enabled := b; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.bpr b/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.bpr deleted file mode 100644 index f0ad06e1370..00000000000 --- a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.bpr +++ /dev/null @@ -1,158 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = LockerDemo.exe -OBJFILES = LockerForm.obj LockerDemo.obj -RESFILES = LockerDemo.res -DEFFILE = -RESDEPEN = $(RESFILES) LockerForm.dfm -LIBFILES = -LIBRARIES = -SPARELIBS = VCL35.lib -PACKAGES = -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -Od -Hc -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I$(BCB)\include;$(BCB)\include\vcl -$Y -$W -$O- -v -JPHN -M -RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl -AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zd -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) -aa -Tpe -x -Gn -v -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj $(PACKAGES) sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.cpp b/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.cpp deleted file mode 100644 index 64071e060ae..00000000000 --- a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.cpp +++ /dev/null @@ -1,21 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("LockerDemo.res"); -USEFORMNS("LockerForm.pas", Lockerform, frmLocker); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->CreateForm(__classid(TfrmLocker), &frmLocker); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.res b/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.res deleted file mode 100644 index b369156c076..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerDemo.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerForm.dfm b/sdk/components/ElPack/BCBDemos/ShapedForm/LockerForm.dfm deleted file mode 100644 index 29722616ff1..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerForm.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerForm.pas b/sdk/components/ElPack/BCBDemos/ShapedForm/LockerForm.pas deleted file mode 100644 index 09734ee241e..00000000000 --- a/sdk/components/ElPack/BCBDemos/ShapedForm/LockerForm.pas +++ /dev/null @@ -1,76 +0,0 @@ -unit LockerForm; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ElImgFrm, ExtCtrls, StdCtrls, ElPopBtn, ElBtnCtl, ElVCLUtils, ElACtrls, - Menus, ElXPThemedControl; - -type - TfrmLocker = class(TForm) - LockedImage: TImage; - UnlockedImage: TImage; - ImageForm: TElImageForm; - CaptionLabel: TLabel; - LockButton: TElPopupButton; - UnlockBkgnd: TImage; - LockBkgnd: TImage; - SampleEdit: TElAdvancedEdit; - PopupMenu1: TPopupMenu; - Close1: TMenuItem; - procedure LockButtonClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure Close1Click(Sender: TObject); - private - Unlocked : boolean; - public - { Public declarations } - end; - -var - frmLocker: TfrmLocker; - -implementation - -{$R *.DFM} - -procedure TfrmLocker.LockButtonClick(Sender: TObject); -begin - Unlocked := not Unlocked; - Hide; - if Unlocked then - begin - ClientHeight := UnlockedImage.Picture.Height; - CaptionLabel.Height := 91; - SampleEdit.Top := 108; - ImageForm.FormImage := UnlockedImage; - ImageForm.Background := UnlockBkgnd.Picture.Bitmap; - LockButton.Caption := 'Lock'; - LockButton.Top := 180; - end else - begin - ClientHeight := LockedImage.Picture.Height; - CaptionLabel.Height := 71; - SampleEdit.Top := 88; - ImageForm.FormImage := LockedImage; - ImageForm.Background := LockBkgnd.Picture.Bitmap; - LockButton.Caption := 'Unlock'; - LockButton.Top := 160; - end; - Show; -end; - -procedure TfrmLocker.FormCreate(Sender: TObject); -begin - ImageForm.Background := LockBkgnd.Picture.Bitmap; - ImageForm.BackgroundType := bgtTileBitmap; -end; - -procedure TfrmLocker.Close1Click(Sender: TObject); -begin - Close; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/ShapedForm/readme.txt b/sdk/components/ElPack/BCBDemos/ShapedForm/readme.txt deleted file mode 100644 index 5182e0945da..00000000000 --- a/sdk/components/ElPack/BCBDemos/ShapedForm/readme.txt +++ /dev/null @@ -1,8 +0,0 @@ -Before you implement your own shaped form, please take a look at the code of -this demo. Several properties are adjusted every time the shape of the form is -changed. - -Also remember to hide the form before changing it's shape to avoid flicker and -other side effects. - -Images are stored in TImage controls, which have width and height set to 0. \ No newline at end of file diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/CalOptions.pas b/sdk/components/ElPack/BCBDemos/TrayDays/CalOptions.pas deleted file mode 100644 index 72824dd8b47..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/CalOptions.pas +++ /dev/null @@ -1,50 +0,0 @@ -unit CalOptions; - -interface - -uses - ElCalendar, Graphics, SysUtils, ElCalendarDefs; - -type TCalOpts = record - ShowWarning : boolean; - WeekEndColor, - HolidayColor, - PeriodsColor: TColor; - ShowHolidays, - ShowPeriods : boolean; - PeriodInterval, - PeriodLength: integer; - PeriodStart : TDateTime; - ShowWeekNums: boolean; - WeekStart : integer; - WeekEnds : TElWeekendDays; - Holidays : TElHolidays; - end; - -var Options : TCalOpts; - -implementation - -initialization - with Options do - begin - ShowWarning := true; - WeekEndColor := clRed; - HolidayColor := clRed; - PeriodsColor := clAqua; - ShowHolidays := true; - ShowPeriods := false; - PeriodInterval := 28; - PeriodLength := 5; - PeriodStart := EncodeDate(1999, 1, 1); - ShowWeekNums := false; - WeekStart := 0; - WeekEnds := [Sat, Sun]; - Holidays := TElHolidays.Create(nil); - end; - -finalization - Options.Holidays.Free; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/FONT.RES b/sdk/components/ElPack/BCBDemos/TrayDays/FONT.RES deleted file mode 100644 index 0de9c0dc0cf..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/TrayDays/FONT.RES and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/Fake.pas b/sdk/components/ElPack/BCBDemos/TrayDays/Fake.pas deleted file mode 100644 index 83ac70e5fe8..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/Fake.pas +++ /dev/null @@ -1,353 +0,0 @@ -unit Fake; - -interface - -uses - Forms, - ElTray, - SysUtils, - Controls, - Classes, - Windows, - Dialogs, - Graphics, - Messages, - Menus, - ElCalendar, - ElCalendarDefs, - ElTimers, - ElTools, - ElIni, - ElStrUtils, - ElShutdownWatcher, - CalOptions, - ElPromptDlg, - frmCalend, (* in 'frmCalend.pas' {CalendarForm}, *) - frmHolidayProp, (* in 'frmHolidayProp.pas' {HolidayPropForm}, *) - frmCalConfig, (* in 'frmCalConfig.pas' {CalConfigForm}, *) - frmDateProp; (* in 'frmDateProp.pas' {DatePropForm}; *) - -type - - TFakeClass = class - public - FTrayIcon : TElTrayIcon; - FTrayMenu : TPopupMenu; - FTimer : TElTimer; - FLastDate : integer; - FConfigIni: TElIniFile; - FBmp : TBitmap; - constructor Create; - destructor Destroy; override; - procedure OnSettingsItemClick(Sender : TObject); - procedure OnExitItemClick(Sender : TObject); - procedure TimerTimer(Sender : TObject); - procedure Run; - procedure UpdateCalendar; - procedure SaveOptions; - procedure LoadOptions; - procedure CheckRemindDays; - end; - -var FakeClass : TFakeClass; - -implementation - -procedure TFakeClass.CheckRemindDays; -var i : integer; - aDay : TElRemindDay; - Today : TDateTime; -begin - ToDay := Date; - for i := 0 to RemindDays.Count - 1 do - begin - aDay := TElRemindDay(RemindDays[i]); - if (not aDay.Notified) and (aDay.Date >= Today) and (aDay.Date - Today <= aDay.RemindTime) then - begin - aDay.Notified := true; - with TElPromptDialog.Create(nil) do - try - DialogCaption := 'EldoS TrayDays'; - Message := Format('%s is in %d days', [aDay.Name, aDay.RemindTime]); - Buttons := [mbOk]; - Show; - finally - Free; - end; - end; - end; -end; - -procedure TFakeClass.UpdateCalendar; -var CalForm : TCalendarForm; -begin - CalForm := TCalendarForm(FTrayIcon.ExtendedHintForm); - - with CalForm do - begin - Calendar.ShowPeriods := Options.ShowPeriods; - Calendar.StartOfWeek := Options.WeekStart; - Calendar.PeriodStart := Options.PeriodStart; - Calendar.PeriodLength := Options.PeriodLength; - Calendar.PeriodInterval := Options.PeriodInterval; - Calendar.WeekEndColor := Options.WeekEndColor; - Calendar.HolidayColor := Options.HolidayColor; - Calendar.PeriodColor := Options.PeriodsColor; - Calendar.WeekEndDays := Options.WeekEnds; - Calendar.Holidays := Options.Holidays; - Calendar.ShowWeekNum := Options.ShowWeekNums; - UpdateRemindDays; - end; -end; - -procedure TFakeClass.OnSettingsItemClick(Sender : TObject); -begin - with TCalConfigForm.Create(nil) do - try - SetData; - if ShowModal = mrOk then - begin - GetData; - UpdateCalendar; - end; - finally - Free; - end; -end; - -procedure TFakeClass.OnExitItemClick(Sender : TObject); -begin - PostMessage(Application.Handle, WM_QUIT, 0, 0); -end; - -procedure TFakeClass.Run; -begin - repeat - Application.HandleMessage; - until - Application.Terminated; -end; - -procedure TFakeClass.SaveOptions; -var St : TMemoryStream; - S : String; - wed : TElWeekEndDay; -begin - FConfigIni.ClearKey('\RemindDays'); - FConfigIni.WriteObject('\RemindDays', RemindDays); - - FConfigIni.WriteColor('\Settings', 'WeekEndColor', Options.WeekEndColor); - FConfigIni.WriteColor('\Settings', 'HolidayColor', Options.HolidayColor); - FConfigIni.WriteBool('\Settings', 'ShowHolidays', Options.ShowHolidays); - FConfigIni.WriteBool('\Settings', 'ShowWeekNums', Options.ShowWeekNums); - FConfigIni.WriteInteger('\Settings', 'WeekStart', Options.WeekStart); - - S := ''; - for wed := Sun to Sat do - if wed in Options.WeekEnds then S := S + char(Smallint(wed)+65); - - FConfigIni.WriteString('\Settings', 'WeekEnds', S); - - St := TMemoryStream.Create; - try - Options.Holidays.SaveToStream(St); - S := Data2Str(St.Memory, St.Size); - FConfigIni.WriteString('\Settings', 'Holidays', S); - finally - St.Free; - end; -end; - -procedure TFakeClass.LoadOptions; -var i : integer; - p1: Pointer; - wed : TElWeekEndDay; - Ss : TElMemoryStream; - S : String; -begin - Options.Holidays := TElHolidays.Create(nil); - - FConfigIni.ReadObject('\RemindDays', RemindDays); - - FConfigIni.ReadColor('\Settings', 'WeekEndColor', clRed, Options.WeekEndColor); - FConfigIni.ReadColor('\Settings', 'HolidayColor', clFuchsia, Options.HolidayColor); - FConfigIni.ReadBool('\Settings', 'ShowHolidays', false, Options.ShowHolidays); - FConfigIni.ReadBool('\Settings', 'ShowWeekNums', false, Options.ShowWeekNums); - FConfigIni.ReadInteger('\Settings', 'WeekStart', 0, Options.WeekStart); - - FConfigIni.ReadString('\Settings', 'WeekEnds', 'AG', S); - - Options.WeekEnds := []; - for wed := Sun to Sat do - if Pos(char(SmallInt(Wed)+65), S) > 0 then Include(Options.WeekEnds, Wed); - - FConfigIni.ReadString('\Settings', 'Holidays', '', S); - - if Str2Data(S, p1, i) then - begin - try - SS := nil; - try - SS := TElMemoryStream.Create; - SS.SetPointer(P1, i); - Options.Holidays.LoadFromStream(SS); - finally - SS.Free; - end; - except - end; - end; -end; - -procedure TFakeClass.TimerTimer; -var ST : TSystemTime; - Bmp: TBitmap; - Msk: TBitmap; - II: TIconInfo; - Icon: TIcon; - C : TColor; - R : TRect; - Font: TBitmap; - i, j: integer; -begin - GetLocalTime(ST); - if (FLastDate <> ST.wDay) then - begin - // generate new icon - Font := TBitmap.Create; - Font.Assign(FBmp); - FConfigIni.ReadColor('\Settings', 'TrayIconColor', clBtnText, C); - for i := 0 to Font.Width -1 do - begin - for j := 0 to Font.Height - 1 do - if Font.Canvas.Pixels[i, j] = clBlack then - Font.Canvas.Pixels[i, j] := C; - end; - - Bmp := TBitmap.Create; - try - Bmp.Width := 16; - Bmp.Height := 16; - Bmp.PixelFormat := pf4bit; - - Msk := TBitmap.Create; - try - Msk.Width := 16; - Msk.Height := 16; - Msk.PixelFormat := pf1bit; - Msk.Canvas.Brush.Color := clWhite; - Msk.Canvas.FillRect(Rect(0,0,16, 16)); - - - R := Rect(0, 0, 16, 16); - Msk.Canvas.Brush.Color := clWhite; - Msk.Canvas.FillRect(R); - R := Rect(0, 0, 15, 15); - - if ST.wDay > 9 then - begin - R := Rect(3, 1, 8, 7); - bitblt(Bmp.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wDay div 10 * 5, 0, SRCCOPY); - end; - R := Rect(10, 1, 15, 7); - bitblt(Bmp.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wDay mod 10 * 5, 0, SRCCOPY); - - R := Rect(3, 9, 8, 7); - bitblt(Bmp.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wMonth div 10 * 5, 0, SRCCOPY); - - R := Rect(10, 9, 15, 7); - bitblt(Bmp.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wMonth mod 10 * 5, 0, SRCCOPY); - - if ST.wDay > 9 then - begin - R := Rect(3, 1, 8, 7); - bitblt(Msk.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wDay div 10 * 5, 0, SRCCOPY); - end; - R := Rect(10, 1, 15, 7); - bitblt(Msk.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wDay mod 10 * 5, 0, SRCCOPY); - - R := Rect(3, 9, 8, 7); - bitblt(Msk.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wMonth div 10 * 5, 0, SRCCOPY); - - R := Rect(10, 9, 15, 7); - bitblt(Msk.Canvas.Handle, R.Left, R.Top, 5, 6, Font.Canvas.Handle, St.wMonth mod 10 * 5, 0, SRCCOPY); - - II.fIcon := true; - II.xHotspot := 0; - II.yHotspot := 0; - II.hbmMask := Msk.Handle; - II.hbmColor := Bmp.Handle; - Icon := TIcon.Create; - Icon.Handle := CreateIconIndirect(II); - FTrayIcon.StaticIcon := Icon; - Icon.Free; - - finally - Msk.Free; - end; - finally - Bmp.Free; - end; - CheckRemindDays; - end; - FLastDate := ST.wDay; -end; - -constructor TFakeClass.Create; -var MI : TMenuItem; - R : TRect; - i : integer; -begin - inherited; - FBmp := TBitmap.Create; - FBmp.LoadFromResourceName(HInstance, 'FONT'); - FConfigIni:= TElIniFile.Create(nil); - FConfigIni.UseRegistry := true; - FConfigIni.Path := 'SOFTWARE\EldoS\TrayDays'; - LoadOptions; - - FTimer := TElTimer.Create; - FTimer.OnTimer := TimerTimer; - - FTrayMenu := TPopupMenu.Create(nil); - MI := Menus.NewItem('&Settings', 0, false, true, OnSettingsItemClick, 0, 'SettingsItem'); - FTrayMenu.Items.Add(MI); - MI := Menus.NewItem('E&xit', 0, false, true, OnExitItemClick, 0, 'ExitItem'); - FTrayMenu.Items.Add(MI); - - FTrayIcon := TElTrayIcon.Create(nil); - FTrayIcon.ExtendedHintInteractive := true; - FTrayIcon.ExtendedHint := 'TCalendarForm'; - FTrayIcon.ExtendedHintDelay := 500; - FTrayIcon.ExtHintWndStyle := Cardinal(WS_POPUP or WS_BORDER or WS_THICKFRAME); - FTrayIcon.ExtHintWndExStyle := WS_EX_TOPMOST or WS_EX_TOOLWINDOW; - - SendMessage(FTrayIcon.ExtendedHintForm.Handle, CM_ShowingChanged, 0, 0); - R := FTrayIcon.ExtendedHintForm.BoundsRect; - FConfigIni.ReadRect('\Settings', 'Size', R, R); - with FTrayIcon.ExtendedHintForm do - SetBounds(Left, Top, R.Right - R.Left, R.Bottom - R.Top); - ShowWindow(Application.Handle, SW_HIDE); - UpdateCalendar; - if FConfigIni.ReadInteger('\Settings', 'BottomPanelHeight', TCalendarForm(FTrayIcon.ExtendedHintForm).BottomPanel.Height, i) then - TCalendarForm(FTrayIcon.ExtendedHintForm).BottomPanel.Height := i; - - FTrayIcon.PopupMenu := FTrayMenu; - TimerTimer(Self); - FTrayIcon.Enabled := true; - FTimer.Enabled := true; -end; - -destructor TFakeClass.Destroy; -begin - FConfigIni.WriteInteger('\Settings', 'BottomPanelHeight', TCalendarForm(FTrayIcon.ExtendedHintForm).BottomPanel.Height); - FConfigIni.WriteRect('\Settings', 'Size', FTrayIcon.ExtendedHintForm.BoundsRect); - SaveOptions; - FTrayIcon.Free; - FTrayMenu.Free; - FConfigIni.Free; - FBmp.Free; - inherited; -end; - -end. diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/KILLDATE.RES b/sdk/components/ElPack/BCBDemos/TrayDays/KILLDATE.RES deleted file mode 100644 index f9c355bb44f..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/TrayDays/KILLDATE.RES and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.bpr b/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.bpr deleted file mode 100644 index 8dcabffea66..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.bpr +++ /dev/null @@ -1,192 +0,0 @@ -# --------------------------------------------------------------------------- -!if !$d(BCB) -BCB = $(MAKEDIR)\.. -!endif - -# --------------------------------------------------------------------------- -# IDE SECTION -# --------------------------------------------------------------------------- -# The following section of the project makefile is managed by the BCB IDE. -# It is recommended to use the IDE to change any of the values in this -# section. -# --------------------------------------------------------------------------- - -VERSION = BCB.03 -# --------------------------------------------------------------------------- -PROJECT = TrayDays.exe -OBJFILES = CalOptions.obj frmCalConfig.obj frmCalend.obj frmDateProp.obj \ - frmHolidayProp.obj Fake.obj TrayDays.obj -RESFILES = FONT.RES KILLDATE.RES TrayDays.res -DEFFILE = -RESDEPEN = $(RESFILES) frmCalConfig.dfm frmCalend.dfm frmDateProp.dfm frmHolidayProp.dfm -LIBFILES = -SPARELIBS = VCL35.lib -PACKAGES = -# --------------------------------------------------------------------------- -PATHCPP = .; -PATHASM = .; -PATHPAS = .; -PATHRC = .; -DEBUGLIBPATH = $(BCB)\lib\debug -RELEASELIBPATH = $(BCB)\lib\release -# --------------------------------------------------------------------------- -CFLAG1 = -Od -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx -tW -CFLAG2 = -D_RTLDLL;USEPACKAGES \ - -I.\;e:\projects\elpack\Code\Source;$(BCB)\include;$(BCB)\include\vcl \ - -H=$(BCB)\lib\vcl35.csm -CFLAG3 = -Tkh30000 -PFLAGS = -U$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -I.\;$(BCB)\include;$(BCB)\include\vcl -$Y -$W \ - -$O- -v -JPHN -M -RFLAGS = -i.\;$(BCB)\include;$(BCB)\include\vcl -AFLAGS = /i.\ /i$(BCB)\include /i$(BCB)\include\vcl \ - /d_RTLDLL /dUSEPACKAGES /mx /w2 /zi -LFLAGS = -L$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \ - -aa -Tpe -x -Gn -v -IFLAGS = -# --------------------------------------------------------------------------- -ALLOBJ = c0w32.obj $(PACKAGES) sysinit.obj $(OBJFILES) -ALLRES = $(RESFILES) -ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib -# --------------------------------------------------------------------------- -!ifdef IDEOPTIONS - -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1049 -CodePage=1251 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[HistoryLists\hlIncludePath] -Count=4 -Item0=.\;e:\projects\elpack\Code\Source;$(BCB)\include;$(BCB)\include\vcl -Item1=.\;e:\projects\elpack\exe;$(BCB)\include;$(BCB)\include\vcl -Item2=.\;e:\projects\elpack\h;$(BCB)\include;$(BCB)\include\vcl -Item3=.\;$(BCB)\include;$(BCB)\include\vcl - -[HistoryLists\hlLibraryPath] -Count=5 -Item0=..\..\..\..\borland\cbuilder3\lib;..\..\lib;$(BCB)\lib\obj;$(BCB)\lib;e:\projects\elpack\lib;e:\projects\elpack\Code\Source -Item1=..\..\..\..\borland\cbuilder3\lib;..\..\lib;$(BCB)\lib\obj;$(BCB)\lib;e:\projects\elpack\lib;;e:\projects\elpack\Code\Source -Item2=..\..\..\..\borland\cbuilder3\lib;..\..\lib;$(BCB)\lib\obj;$(BCB)\lib;e:\projects\elpack\lib -Item3=..\..\lib;$(BCB)\lib\obj;$(BCB)\lib -Item4=..\..\lib;$(BCB)\lib\obj;$(BCB)\lib;E:\projects\ElPack\Code\Source - -[HistoryLists\hlDebugSourcePath] -Count=1 -Item0=$(BCB)\source\vcl - -[HistoryLists\hlConditionals] -Count=1 -Item0=_RTLDLL;USEPACKAGES - -[HistoryLists\hlIntOutputDir] -Count=3 -Item0=.Item1=e:\projects\elpack\exe -Item1= -Item2=.[Debugging] - -[Debugging] -DebugSourceDirs= - -[Parameters] -RunParams= -HostApplication= - -!endif - -# --------------------------------------------------------------------------- -# MAKE SECTION -# --------------------------------------------------------------------------- -# This section of the project file is not used by the BCB IDE. It is for -# the benefit of building from the command-line using the MAKE utility. -# --------------------------------------------------------------------------- - -.autodepend -# --------------------------------------------------------------------------- -!if !$d(BCC32) -BCC32 = bcc32 -!endif - -!if !$d(DCC32) -DCC32 = dcc32 -!endif - -!if !$d(TASM32) -TASM32 = tasm32 -!endif - -!if !$d(LINKER) -LINKER = ilink32 -!endif - -!if !$d(BRCC32) -BRCC32 = brcc32 -!endif -# --------------------------------------------------------------------------- -!if $d(PATHCPP) -.PATH.CPP = $(PATHCPP) -.PATH.C = $(PATHCPP) -!endif - -!if $d(PATHPAS) -.PATH.PAS = $(PATHPAS) -!endif - -!if $d(PATHASM) -.PATH.ASM = $(PATHASM) -!endif - -!if $d(PATHRC) -.PATH.RC = $(PATHRC) -!endif -# --------------------------------------------------------------------------- -$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) - $(BCB)\BIN\$(LINKER) @&&! - $(LFLAGS) + - $(ALLOBJ), + - $(PROJECT),, + - $(ALLLIB), + - $(DEFFILE), + - $(ALLRES) -! -# --------------------------------------------------------------------------- -.pas.hpp: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.pas.obj: - $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< } - -.cpp.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.c.obj: - $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< } - -.asm.obj: - $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@ - -.rc.res: - $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $< -# --------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.cpp b/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.cpp deleted file mode 100644 index 7c59777dc26..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.cpp +++ /dev/null @@ -1,32 +0,0 @@ -//--------------------------------------------------------------------------- -#include -#pragma hdrstop -USERES("FONT.RES"); -USERES("KILLDATE.RES"); -USERES("TrayDays.res"); -USEUNIT("CalOptions.pas"); -USEFORMNS("frmCalConfig.pas", Frmcalconfig, CalConfigForm); -USEFORMNS("frmCalend.pas", Frmcalend, CalendarForm); -USEFORMNS("frmDateProp.pas", Frmdateprop, DatePropForm); -USEFORMNS("frmHolidayProp.pas", Frmholidayprop, HolidayPropForm); -USEUNIT("Fake.pas"); -//--------------------------------------------------------------------------- -#include -//--------------------------------------------------------------------------- - -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - Application->Initialize(); - Application->Title = "EldoS TrayDays"; - FakeClass = new TFakeClass(); - try - { - FakeClass->Run(); - } - __finally - { - FakeClass->Free(); - } - return 0; -} -//--------------------------------------------------------------------------- diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.res b/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.res deleted file mode 100644 index 74c4cbbd932..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/TrayDays/TrayDays.res and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalConfig.dfm b/sdk/components/ElPack/BCBDemos/TrayDays/frmCalConfig.dfm deleted file mode 100644 index 9cee7acfac7..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalConfig.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalConfig.pas b/sdk/components/ElPack/BCBDemos/TrayDays/frmCalConfig.pas deleted file mode 100644 index 275aa42a1d8..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalConfig.pas +++ /dev/null @@ -1,219 +0,0 @@ -unit frmCalConfig; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ComCtrls, StdCtrls, ElTree, ElPopBtn, ElACtrls, - ElCalendar, frmHolidayProp, ElBtnCtl, ElCheckCtl, ElSpin, ElFlatCtl, - ElClrCmb, CalOptions, ElCalendarDefs, ElPgCtl, ElXPThemedControl; - -type - TCalConfigForm = class(TForm) - OpenDlg: TOpenDialog; - SaveDlg: TSaveDialog; - OkBtn: TElPopupButton; - CancelBtn: TElPopupButton; - Pages: TElPageControl; - GeneralPage: TElTabSheet; - HolidaysPage: TElTabSheet; - Label1: TLabel; - Label2: TLabel; - Label4: TLabel; - WeekendColorCombo: TElColorCombo; - WeekNumsCB: TElCheckBox; - WeekEndList: TElAdvancedListBox; - StartDayCombo: TElAdvancedComboBox; - Label3: TLabel; - HoliColorCombo: TElColorCombo; - HolidaysList: TElTree; - HolidayAddBtn: TElPopupButton; - HolidayRemoveBtn: TElPopupButton; - HolidayModifyBtn: TElPopupButton; - HolidaysSaveBtn: TElPopupButton; - HolidaysLoadBtn: TElPopupButton; - HolidaysCB: TElCheckBox; - procedure HolidayAddBtnClick(Sender: TObject); - procedure HolidayModifyBtnClick(Sender: TObject); - procedure HolidaysListItemFocused(Sender: TObject); - procedure HolidayRemoveBtnClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure HolidaysSaveBtnClick(Sender: TObject); - procedure HolidaysLoadBtnClick(Sender: TObject); - procedure HolidaysListItemDeletion(Sender: TObject; Item: TElTreeItem); - private - { Private declarations } - Holidays : TElHolidays; - public - procedure AddHolidayToList(AHoliday : TElHoliday); - procedure GetData; - procedure SetData; - end; - -var - CalConfigForm: TCalConfigForm; - -implementation - -{$R *.DFM} - -procedure TCalConfigForm.GetData; -var I : Integer; - WED : TElWeekEndDays; -begin - with Options do - begin - Holidays.Assign(Self.Holidays); - Options.ShowWeekNums := WeekNumsCB.Checked; - ShowHolidays := HolidaysCB.Checked; - Options.WeekStart := TDayOfWeek(StartDayCombo.ItemIndex); - WeekEndColor := WeekendColorCombo.SelectedColor; - HolidayColor := HoliColorCombo.SelectedColor; - Wed := []; - for i := 0 to 6 do // Iterate - begin - if WeekEndList.Selected[i] - then Include(WED, TElWeekEndDay(i)) - else Exclude(WED, TElWeekEndDay(i)); - end; // for - Options.WeekEnds := WED; - end; -end; - -procedure TCalConfigForm.SetData; -var I: Integer; -begin - Holidays.Assign(Options.Holidays); - for i := 0 to 6 do // Iterate - if TElWeekEndDay(i) in Options.WeekEnds then WeekEndList.Selected[i] := true; - for i := 0 to Holidays.Count - 1 do AddHolidayToList(Holidays.Items[i]); - WeekNumsCB.Checked := Options.ShowWeekNums; - HolidaysCB.Checked := Options.ShowHolidays; - - StartDayCombo.ItemIndex := Integer(Options.WeekStart); - WeekendColorCombo.SelectedColor := Options.WeekEndColor; - HoliColorCombo.SelectedColor := Options.HolidayColor; -end; - -procedure TCalConfigForm.AddHolidayToList(AHoliday : TElHoliday); -var Item : TElTreeItem; -begin - Item := HolidaysList.Items.AddItem(nil); - Item.ColumnText.Add(AHoliday.Description); - if AHoliday.FixedDate - then Item.Text := IntToStr(AHoliday.Day) + ' ' + LongMonthNames[AHoliday.Month] - else Item.Text := IntToStr(AHoliday.Day) + ' ' + LongDayNames[AHoliday.DayOfWeek + 1] + - ' ' + LongMonthNames[AHoliday.Month]; - Item.Data := AHoliday; -end; - -procedure TCalConfigForm.HolidayAddBtnClick(Sender: TObject); -var AHoliday : TELHoliday; -begin - AHoliday := Holidays.Add; - HolidayPropForm := THolidayPropForm.Create(nil); - HolidayPropForm.AHoliday := AHoliday; - HolidayPropForm.SetData; - if HolidayPropForm.ShowModal = mrOk then - begin - HolidayPropForm.GetData; - AddHolidayToList(AHoliday); - end - else AHoliday.Free; - HolidayPropForm.Free; -end; - -procedure TCalConfigForm.HolidayModifyBtnClick(Sender: TObject); -var AHoliday : TELHoliday; -begin - if HolidaysList.ItemFocused = nil then Exit; - AHoliday := TElHoliday(HolidaysList.ItemFocused.Data); - HolidayPropForm := THolidayPropForm.Create(nil); - HolidayPropForm.AHoliday := AHoliday; - HolidayPropForm.SetData; - if HolidayPropForm.ShowModal = mrOk then - begin - HolidayPropForm.GetData; - HolidaysList.ItemFocused.ColumnText.Clear; - HolidaysList.ItemFocused.ColumnText.Add(AHoliday.Description); - if AHoliday.FixedDate - then HolidaysList.ItemFocused.Text := IntToStr(AHoliday.Day) + ' ' + LongMonthNames[AHoliday.Month] - else HolidaysList.ItemFocused.Text := IntToStr(AHoliday.Day) + ' ' + LongDayNames[AHoliday.DayOfWeek + 1] + - ' ' + LongMonthNames[AHoliday.Month]; - end; - HolidayPropForm.Free; -end; - -procedure TCalConfigForm.HolidaysListItemFocused(Sender: TObject); -begin - HolidayModifyBtn.Enabled := HolidaysList.ItemFocused <> nil; - HolidayRemoveBtn.Enabled := HolidaysList.ItemFocused <> nil; -end; - -procedure TCalConfigForm.HolidayRemoveBtnClick(Sender: TObject); -begin - if HolidaysList.ItemFocused = nil then Exit; - HolidaysList.Items.DeleteItem(HolidaysList.ItemFocused); -end; - -procedure TCalConfigForm.FormCreate(Sender: TObject); -begin - Holidays := TElHolidays.Create(Self); -end; - -procedure TCalConfigForm.FormDestroy(Sender: TObject); -begin - Holidays.Free; - Holidays := nil; -end; - -procedure TCalConfigForm.HolidaysSaveBtnClick(Sender: TObject); -var Stream : TFileStream; -begin - if SaveDlg.Execute then - begin - Stream := nil; - try - try - Stream := TFileStream.Create(SaveDlg.FileName, fmCreate or fmShareDenyWrite); - Holidays.SaveToStream(Stream); - finally // wrap up - Stream.Free; - end; // try/finally - except - MessageDlg('Failed to save holidays', mtError, [mbOk], 0); - end; - end; -end; - -procedure TCalConfigForm.HolidaysLoadBtnClick(Sender: TObject); -var Stream : TFileStream; - i : integer; -begin - if OpenDlg.Execute then - begin - Stream := nil; - try - try - Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead or fmShareDenyWrite); - Holidays.LoadFromStream(Stream); - HolidaysList.Items.Clear; - for i := 0 to Holidays.Count - 1 do AddHolidayToList(Holidays.Items[i]); - finally // wrap up - Stream.Free; - end; // try/finally - except - MessageDlg('Failed to load holidays', mtError, [mbOk], 0); - end; - end; -end; - -procedure TCalConfigForm.HolidaysListItemDeletion(Sender: TObject; - Item: TElTreeItem); -begin - if Assigned(Item) and Assigned(Holidays) then TElHoliday(Item.Data).Free; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalend.dfm b/sdk/components/ElPack/BCBDemos/TrayDays/frmCalend.dfm deleted file mode 100644 index e2227fa871c..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalend.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalend.pas b/sdk/components/ElPack/BCBDemos/TrayDays/frmCalend.pas deleted file mode 100644 index f83457161a4..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/frmCalend.pas +++ /dev/null @@ -1,273 +0,0 @@ -unit frmCalend; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - Grids, ElCalendar, StdCtrls, ElACtrls, ElSpin, ElBtnCtl, ElPopBtn, - ExtCtrls, ElPanel, ElSplit, ElObjList, ElPromptDlg, ElCombos, - ElHTMLView, ElXPThemedControl; - -type - - TElRemindDay = class; - - TCalendarForm = class(TForm) - Panel1: TPanel; - PrevMonBtn: TElPopupButton; - PrevYearBtn: TElPopupButton; - NextMonBtn: TElPopupButton; - NextYearBtn: TElPopupButton; - YearSpin: TElSpinEdit; - Calendar: TElCalendar; - BottomPanel: TElPanel; - ReminderView: TElHTMLView; - Splitter: TElSplitter; - btnAddDay: TElPopupButton; - MonthCombo: TElComboBox; - procedure PrevYearBtnClick(Sender: TObject); - procedure NextYearBtnClick(Sender: TObject); - procedure NextMonBtnClick(Sender: TObject); - procedure PrevMonBtnClick(Sender: TObject); - procedure MonthComboChange(Sender: TObject); - procedure YearSpinChange(Sender: TObject); - procedure CalendarChange(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure FormResize(Sender: TObject); - procedure ReminderViewLinkClick(Sender: TObject; HRef: TElFString); - procedure ReminderViewImageNeeded(Sender: TObject; Src: TElFString; - var Image: TBitmap); - procedure btnAddDayClick(Sender: TObject); - private - public - procedure CreateParams(var Params: TCreateParams); override; - procedure SetNames; - procedure UpdateLabel; - procedure UpdateRemindDays; - function ConfigureRemindDay(ADay : TElRemindDay) : boolean; - end; - - TElRemindDay = class(TElObjectListItem) - private - FRemindTime : integer; - FName : string; - FDate : TDateTime; - FNotified : boolean; - published - property Name : string read FName write FName; - property RemindTime : integer read FRemindTime write FRemindTime; - property Date : TDateTime read FDate write FDate; - property Notified : boolean read FNotified write FNotified; - end; - -var - - CalendarForm: TCalendarForm; - RemindDays : TElObjectList; - KillBmp : TBitmap; - -{$R 'killdate.res'} - -const OrigHeight = -11; - OrigWidth = 193; - -implementation - -{$R *.DFM} - -uses frmDateProp; - -procedure TCalendarForm.SetNames; -var - i : integer; -begin - for i := 1 to 12 do - MonthCombo.Items.Add(LongMonthNames[i]); -end; - -procedure TCalendarForm.UpdateLabel; -begin - MonthCombo.ItemIndex := Calendar.Month - 1; - YearSpin.Value := Calendar.Year; -end; - -procedure TCalendarForm.PrevYearBtnClick(Sender: TObject); -begin - Calendar.Year := Calendar.Year - 1; - UpdateLabel; -end; - -procedure TCalendarForm.NextYearBtnClick(Sender: TObject); -begin - Calendar.Year := Calendar.Year + 1; - UpdateLabel; -end; - -procedure TCalendarForm.NextMonBtnClick(Sender: TObject); -begin - if Calendar.Month = 12 then - begin - Calendar.Month := 1; - Calendar.Year := Calendar.Year + 1; - end - else - Calendar.Month := Calendar.Month + 1; - UpdateLabel; -end; - -procedure TCalendarForm.PrevMonBtnClick(Sender: TObject); -begin - if Calendar.Month = 1 then - begin - Calendar.Month := 12; - Calendar.Year := Calendar.Year - 1; - end - else - Calendar.Month := Calendar.Month - 1; - UpdateLabel; -end; - -procedure TCalendarForm.MonthComboChange(Sender: TObject); -begin - if (MonthCombo.ItemIndex >= 0) and (MonthCombo.ItemIndex < 12) then - Calendar.Month := MonthCombo.ItemIndex + 1; -end; - -procedure TCalendarForm.YearSpinChange(Sender: TObject); -var - FSaveYear : integer; -begin - FSaveYear := Calendar.Year; - try - Calendar.Year := Trunc(YearSpin.Value); - except - Calendar.Year := FSaveYear; - end; -end; - -procedure TCalendarForm.CalendarChange(Sender: TObject); -begin - UpdateLabel; -end; - -procedure TCalendarForm.CreateParams(var Params: TCreateParams); { protected } -begin - inherited; - Params.Style := WS_POPUP or WS_BORDER or WS_THICKFRAME; -end; { CreateParams } - -procedure TCalendarForm.FormCreate(Sender: TObject); -begin - //SetNames; -end; - -procedure TCalendarForm.FormShow(Sender: TObject); -begin - UpdateLabel; -end; - -procedure TCalendarForm.FormResize(Sender: TObject); -begin - Calendar.Font.Height := MulDiv(OrigHeight, ClientWidth, OrigWidth); -end; - -function TCalendarForm.ConfigureRemindDay(ADay : TElRemindDay) : boolean; -begin - result := false; - with TDatePropForm.Create(nil) do - try - SetData(ADay); - if ShowModal = mrOk then - begin - GetData(ADay); - result := true; - end; - finally - free; - end; -end; - -procedure TCalendarForm.UpdateRemindDays; -var s : string; - Day : TElRemindDay; - Today: TDateTime; - i : integer; -begin - S := ''; - Today := Trunc(Now); - for i := 0 to RemindDays.Count - 1 do - begin - Day := TElRemindDay(RemindDays[i]); - if Day.Date < Today then - S := S + Format('%d days after %s ', [Trunc(Today - Day.Date), Integer(Pointer(Day)), Day.Name]) - else - if Day.Date > Today then - S := S + Format('%d days until %s ', [Trunc(Day.Date - Today), Integer(Pointer(Day)), Day.Name]) - else - S := S + Format('Today is %s ', [Integer(Pointer(Day)), Day.Name]); - S := S + Format('
', [Integer(Pointer(Day))]); - end; - ReminderView.Caption := S; -end; - -procedure TCalendarForm.ReminderViewLinkClick(Sender: TObject; - HRef: TElFString); -var i : integer; -begin - i := StrToIntDef(HRef, 0); - if i > 0 then - begin - if ConfigureRemindDay(TElRemindDay(Pointer(i))) then - UpdateRemindDays; - end - else - if i < 0 then - begin - if ElMessageDlg(Format('Do you want to delete %s?', [TElRemindDay(Pointer(-i)).Name]), mtWarning, [mbYes, mbNo], 0) = mrYes then - begin - RemindDays.Remove(Pointer(-i)); - UpdateRemindDays; - end; - end; -end; - -procedure TCalendarForm.ReminderViewImageNeeded(Sender: TObject; - Src: TElFString; var Image: TBitmap); -begin - if src = 'killimage' then - Image := KillBmp - else - Image := nil; -end; - -procedure TCalendarForm.btnAddDayClick(Sender: TObject); -var ADay : TElRemindDay; -begin - ADay := TElRemindDay(RemindDays.Add); - ADay.Date := Trunc(Now + 1); - if ConfigureRemindDay(ADay) then - begin - UpdateRemindDays; - end else - begin - RemindDays.Remove(ADay); - end; -end; - -initialization - - RegisterClass(TCalendarForm); - - RemindDays := TElObjectList.Create(nil, TElRemindDay); - RemindDays.AutoClearObjects := true; - KillBmp := TBitmap.Create; - KillBmp.LoadFromResourceName(HInstance, 'KILLDATEIMAGE'); - -finalization - - KillBmp.Free; - RemindDays.Free; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmDateProp.dfm b/sdk/components/ElPack/BCBDemos/TrayDays/frmDateProp.dfm deleted file mode 100644 index 4bcfba93296..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/TrayDays/frmDateProp.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmDateProp.pas b/sdk/components/ElPack/BCBDemos/TrayDays/frmDateProp.pas deleted file mode 100644 index 7348f76f138..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/frmDateProp.pas +++ /dev/null @@ -1,51 +0,0 @@ -unit frmDateProp; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElACtrls, ElBtnCtl, ElPopBtn, ElFlatCtl, ComCtrls, ElSpin, frmCalend, - ElDTPick, ElXPThemedControl; - -type - TDatePropForm = class(TForm) - OkBtn: TElPopupButton; - CancelBtn: TElPopupButton; - Label1: TLabel; - NameEdit: TElAdvancedEdit; - Label2: TLabel; - ElFlatController1: TElFlatController; - Label3: TLabel; - RemindSpin: TElSpinEdit; - Label4: TLabel; - DateEdit: TElDateTimePicker; - private - { Private declarations } - public - procedure SetData(ADay : TElRemindDay); - procedure GetData(ADay : TElRemindDay); - end; - -var - DatePropForm: TDatePropForm; - -implementation - -{$R *.DFM} - -procedure TDatePropForm.SetData(ADay : TElRemindDay); -begin - NameEdit.Text := ADay.Name; - DateEdit.Date := ADay.Date; - RemindSpin.Value := ADay.RemindTime; -end; - -procedure TDatePropForm.GetData(ADay : TElRemindDay); -begin - ADay.Name := NameEdit.Text; - ADay.Date := Trunc(DateEdit.Date); - ADay.RemindTime := RemindSpin.Value; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmHolidayProp.dfm b/sdk/components/ElPack/BCBDemos/TrayDays/frmHolidayProp.dfm deleted file mode 100644 index 96f6debf475..00000000000 Binary files a/sdk/components/ElPack/BCBDemos/TrayDays/frmHolidayProp.dfm and /dev/null differ diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/frmHolidayProp.pas b/sdk/components/ElPack/BCBDemos/TrayDays/frmHolidayProp.pas deleted file mode 100644 index 2b0a3139a04..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/frmHolidayProp.pas +++ /dev/null @@ -1,93 +0,0 @@ -unit frmHolidayProp; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ElACtrls, ExtCtrls, ElPopBtn, ElCalendar, ElBtnCtl, ElCheckCtl, - ElCalendarDefs, ElXPThemedControl; - -type - THolidayPropForm = class(TForm) - IsRestCB: TElCheckBox; - Panel1: TPanel; - Panel2: TPanel; - Label9: TLabel; - FloatDayCombo: TElAdvancedComboBox; - FloatDOWCombo: TElAdvancedComboBox; - FloatMonthCombo: TElAdvancedComboBox; - FloatDateRB: TElRadioButton; - Panel3: TPanel; - Label2: TLabel; - FixedDayCombo: TElAdvancedComboBox; - FixedMonthCombo: TElAdvancedComboBox; - FixedDateRB: TElRadioButton; - DescriptionEdit: TElAdvancedEdit; - Label1: TLabel; - OkBtn: TElPopupButton; - CancelBtn: TElPopupButton; - procedure FixedDateRBClick(Sender: TObject); - private - { Private declarations } - public - AHoliday : TElHoliday; - procedure SetData; - procedure GetData; - end; - -var - HolidayPropForm: THolidayPropForm; - -implementation - -{$R *.DFM} - -procedure THolidayPropForm.GetData; -begin - AHoliday.Description := DescriptionEdit.Text; - AHoliday.FixedDate := FixedDateRB.Checked; - if FixedDateRB.Checked then - begin - AHoliday.Month := FixedMonthCombo.ItemIndex + 1; - AHoliday.Day := FixedDayCombo.ItemIndex + 1; - end else - begin - AHoliday.Month := FloatMonthCombo.ItemIndex + 1; - AHoliday.DayOfWeek := FloatDOWCombo.ItemIndex; - AHoliday.Day := FloatDayCombo.ItemIndex + 1; - end; - AHoliday.IsRest := IsRestCB.Checked; -end; - -procedure THolidayPropForm.SetData; -begin - DescriptionEdit.Text := AHoliday.Description; - FixedDateRB.Checked := AHoliday.FixedDate; - FloatDateRB.Checked := not AHoliday.FixedDate; - FixedDateRBClick(Self); - if AHoliday.FixedDate then - begin - FixedMonthCombo.ItemIndex := AHoliday.Month - 1; - FixedDayCombo.ItemIndex := AHoliday.Day - 1; - end else - begin - FloatDayCombo.ItemIndex := AHoliday.Day - 1; - FloatDOWCombo.ItemIndex := AHoliday.DayOfWeek; - FloatMonthCombo.ItemIndex := AHoliday.Month - 1; - end; - IsRestCB.Checked := AHoliday.IsRest; -end; - -procedure THolidayPropForm.FixedDateRBClick(Sender: TObject); -var b : Boolean; -begin - b := FixedDateRB.Checked; - FixedDayCombo.Enabled := b; - FixedMonthCombo.Enabled := b; - FloatDayCombo.Enabled := not b; - FloatDOWCombo.Enabled := not b; - FloatMonthCombo.Enabled := not b; -end; - -end. - diff --git a/sdk/components/ElPack/BCBDemos/TrayDays/readme.txt b/sdk/components/ElPack/BCBDemos/TrayDays/readme.txt deleted file mode 100644 index b6b65c5771c..00000000000 --- a/sdk/components/ElPack/BCBDemos/TrayDays/readme.txt +++ /dev/null @@ -1,4 +0,0 @@ -This is the complete source code of TrayDays application, available from EldoS. -You can use this code only as example of using ElPack, and especially -ElCalendar and ElTrayIcon components. You may not distribute either exact or -modified TrayDays application. \ No newline at end of file diff --git a/sdk/components/ElPack/bpl/elpackB6.BPL b/sdk/components/ElPack/bpl/elpackB6.BPL deleted file mode 100644 index b13e9af7d0b..00000000000 Binary files a/sdk/components/ElPack/bpl/elpackB6.BPL and /dev/null differ diff --git a/sdk/components/ElPack/bpl/elpkdbB6.BPL b/sdk/components/ElPack/bpl/elpkdbB6.BPL deleted file mode 100644 index abd1a516b11..00000000000 Binary files a/sdk/components/ElPack/bpl/elpkdbB6.BPL and /dev/null differ diff --git a/sdk/components/ElPack/bpl/elpproB6.BPL b/sdk/components/ElPack/bpl/elpproB6.BPL deleted file mode 100644 index bccbd094364..00000000000 Binary files a/sdk/components/ElPack/bpl/elpproB6.BPL and /dev/null differ diff --git a/sdk/components/ElPack/tools/uninst.exe b/sdk/components/ElPack/tools/uninst.exe deleted file mode 100644 index 1f30f052a95..00000000000 Binary files a/sdk/components/ElPack/tools/uninst.exe and /dev/null differ