pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

flashfiler: Initial commit (ported by A.Soner). Not working yet (server error).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-07 13:31:59 +00:00
parent 29942837b1
commit 27aea1d1ad
353 changed files with 183835 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
components/flashfiler/#Readme.txt Normal file
View File

@ -0,0 +1,35 @@
TurboPower FlashFiler2 Lazarus port
Used original version:tpflashfiler_2_13 from SourceForge
https://sourceforge.net/projects/tpflashfiler/
Port infos are in sourcelaz\LazConvertReadMe.txt
Lazaruspackage is in folder packages: lazff2.lpk
Look the image for folderstructre. I zipped only changed files. Other files are located on sourceforge.
In finalversion will be inclued all and published on github/sourceforge/..
***
NO MORE BORLAND CODE, It uses now TExprParser from fssql.
sourcelaz\lazdbcommon.pas ->since 2016.05.04: (lazcommon.pas and lazconsts.pas)
sourcelaz\LazDbComSqlTimSt.pas <--- used in lazdbcommon.pas
To disable Delphi units define in ffdefine.inc: (compiles without delphi units)
{$DEFINE DONTUSEDELPHIUNIT} //Disables in ffdb.pas the function TffDataSet.dsCreateLookupFilter
//if it called then it raises exception!
**************
FOR EXAMPLES configure server (flashfiler\bin\ffserver.exe) and
make 2 aliases in [ffserver-Menu > Config > Aliases ... ]
Alias: Path:
mythicdb yourfolder\flashfiler\examples\mythicdb
Tutorial yourfolder\flashfiler\examples
THERE IS TEXPRPARSER in:
-JVCL JvExprParser.pas
-TXQuery QExprYacc.pas with MozillaPublicLicense
Have fun!
Soner A.

BIN
components/flashfiler/examples/LazCustLookup/LazCustLookup.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

88
components/flashfiler/examples/LazCustLookup/LazCustLookup.lpi Normal file
View File

@ -0,0 +1,88 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="LazCustLookup"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="lazff2"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="LazCustLookup.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="lazcustlookupmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="LazCustLookupMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="LazCustLookup"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/flashfiler/examples/LazCustLookup/LazCustLookup.lpr Normal file
View File

@ -0,0 +1,21 @@
program LazCustLookup;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, LazCustLookupMain, lazff2
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
components/flashfiler/examples/LazCustLookup/LazCustLookup.res Normal file
View File

Binary file not shown.

509
components/flashfiler/examples/LazCustLookup/lazcustlookupmain.lfm Normal file
View File

@ -0,0 +1,509 @@
object Form1: TForm1
Left = 315
Height = 478
Top = 121
Width = 604
Caption = 'FlashFiler for Lazarus Demo2'
ClientHeight = 478
ClientWidth = 604
OnCreate = FormCreate
LCLVersion = '1.6.1.0'
object ToolBar1: TToolBar
Left = 0
Height = 22
Top = 0
Width = 604
AutoSize = True
Caption = 'ToolBar1'
EdgeBorders = []
TabOrder = 0
object DBNavigator1: TDBNavigator
Left = 1
Height = 22
Top = 0
Width = 241
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 22
ClientWidth = 241
DataSource = DataSource1
Options = []
TabOrder = 0
end
object DBLookupComboBox1: TDBLookupComboBox
Left = 242
Height = 21
Top = 0
Width = 100
DataField = 'Company'
DataSource = DataSource1
ListFieldIndex = 0
LookupCache = False
TabOrder = 1
end
end
object DBGrid1: TDBGrid
Left = 0
Height = 366
Top = 22
Width = 604
Align = alClient
Color = clWindow
Columns = <>
DataSource = DataSource1
TabOrder = 1
end
object Memo1: TMemo
Left = 0
Height = 90
Top = 388
Width = 604
Align = alBottom
Lines.Strings = (
'TDBLookupComboBox shows no Fieldvalues'
''
'[Solved for Loookup-Field in TDBGrid'
'Lookup-Fields raises EVariantError-Exception on FreePascal:'
'Try to Change Value of Customer-Field.'
'--'
'ffdb'
'7929..'
'EVariantError : Invalid variant type cast'
'--'
']'
)
ScrollBars = ssVertical
TabOrder = 2
end
object ffLegacyTransport1: TffLegacyTransport
Enabled = True
ServerName = 'Local server'
left = 366
top = 198
end
object FFRemoteServerEngine1: TFFRemoteServerEngine
Transport = ffLegacyTransport1
left = 282
top = 198
end
object ffClient1: TffClient
Active = True
ClientName = 'ffClient1Laz'
ServerEngine = FFRemoteServerEngine1
left = 448
top = 198
end
object ffSession1: TffSession
Active = True
ClientName = 'ffClient1Laz'
SessionName = 'ffSession1laz'
TimeOut = 2000
left = 510
top = 198
end
object ffDatabase1: TffDatabase
AliasName = 'mythicdb'
Connected = True
DatabaseName = 'DbLookuplaz'
SessionName = 'ffSession1laz'
left = 282
top = 266
end
object ffTable1: TffTable
DatabaseName = 'DbLookuplaz'
FieldDefs = <
item
Name = 'OrderNo'
DataType = ftAutoInc
Precision = -1
end
item
Name = 'Status'
DataType = ftString
Precision = -1
Size = 1
end
item
Name = 'CustNo'
DataType = ftInteger
Precision = -1
end
item
Name = 'SaleDate'
DataType = ftDateTime
Precision = -1
end
item
Name = 'ShipDate'
DataType = ftDateTime
Precision = -1
end
item
Name = 'EmpNo'
DataType = ftInteger
Precision = -1
end
item
Name = 'ShipToContact'
DataType = ftString
Precision = -1
Size = 20
end
item
Name = 'ShipToAddr1'
DataType = ftString
Precision = -1
Size = 30
end
item
Name = 'ShipToAddr2'
DataType = ftString
Precision = -1
Size = 30
end
item
Name = 'ShipToCity'
DataType = ftString
Precision = -1
Size = 15
end
item
Name = 'ShipToState'
DataType = ftString
Precision = -1
Size = 20
end
item
Name = 'ShipToZip'
DataType = ftString
Precision = -1
Size = 10
end
item
Name = 'ShipToCountry'
DataType = ftString
Precision = -1
Size = 20
end
item
Name = 'ShipToPhone'
DataType = ftString
Precision = -1
Size = 15
end
item
Name = 'ShipVIA'
DataType = ftString
Precision = -1
Size = 7
end
item
Name = 'PO'
DataType = ftString
Precision = -1
Size = 15
end
item
Name = 'Terms'
DataType = ftString
Precision = -1
Size = 6
end
item
Name = 'PaymentMethod'
DataType = ftString
Precision = -1
Size = 7
end
item
Name = 'CCNumber'
DataType = ftString
Precision = -1
Size = 16
end
item
Name = 'CCExpMonth'
DataType = ftSmallint
Precision = -1
end
item
Name = 'CCExpYear'
DataType = ftSmallint
Precision = -1
end
item
Name = 'ItemsTotal'
DataType = ftCurrency
Precision = -1
end
item
Name = 'TaxRate'
DataType = ftFloat
Precision = -1
end
item
Name = 'Freight'
DataType = ftCurrency
Precision = -1
end
item
Name = 'AmountPaid'
DataType = ftCurrency
Precision = -1
end
item
Name = 'DistribCenterID'
DataType = ftInteger
Precision = -1
end>
FilterOptions = []
IndexDefs = <
item
Name = 'Sequential Access Index'
Options = [ixUnique, ixCaseInsensitive, ixExpression]
end
item
Name = 'FF$PRIMARY'
Fields = 'OrderNo'
Options = [ixUnique]
end
item
Name = 'CustNo'
Fields = 'CustNo'
Options = []
end
item
Name = 'CustNo_SaleDate'
Fields = 'CustNo;SaleDate'
Options = [ixCaseInsensitive]
end
item
Name = 'Status'
Fields = 'Status'
Options = [ixCaseInsensitive]
end
item
Name = 'ByDistribCenter'
Fields = 'DistribCenterID'
Options = [ixCaseInsensitive]
end>
IndexName = 'CustNo'
SessionName = 'ffSession1laz'
TableName = 'orders'
left = 366
top = 268
object ffTable1OrderNo: TAutoIncField
FieldKind = fkData
FieldName = 'OrderNo'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object ffTable1Status: TStringField
FieldKind = fkData
FieldName = 'Status'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 1
end
object ffTable1CustNo: TLongintField
FieldKind = fkData
FieldName = 'CustNo'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object StringField1: TStringField
FieldKind = fkLookup
FieldName = 'Company'
Index = 3
KeyFields = 'CustNo'
LookupCache = False
LookupDataSet = ffTaCustomer
LookupKeyFields = 'ID'
LookupResultField = 'Company'
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 30
end
object ffTable1SaleDate: TDateTimeField
FieldKind = fkData
FieldName = 'SaleDate'
Index = 4
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object ffTable1ShipDate: TDateTimeField
FieldKind = fkData
FieldName = 'ShipDate'
Index = 5
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object ffTable1EmpNo: TLongintField
FieldKind = fkData
FieldName = 'EmpNo'
Index = 6
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object ffTable1ShipToContact: TStringField
FieldKind = fkData
FieldName = 'ShipToContact'
Index = 7
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
end
object DataSource1: TDataSource
DataSet = ffTable1
left = 428
top = 270
end
object ffTaCustomer: TffTable
DatabaseName = 'DbLookuplaz'
FieldDefs = <
item
Name = 'ID'
DataType = ftAutoInc
Precision = -1
end
item
Name = 'Company'
DataType = ftString
Precision = -1
Size = 30
end
item
Name = 'Address1'
DataType = ftString
Precision = -1
Size = 30
end
item
Name = 'Address2'
DataType = ftString
Precision = -1
Size = 30
end
item
Name = 'City'
DataType = ftString
Precision = -1
Size = 15
end
item
Name = 'State'
DataType = ftString
Precision = -1
Size = 20
end
item
Name = 'Zip'
DataType = ftString
Precision = -1
Size = 10
end
item
Name = 'Country'
DataType = ftString
Precision = -1
Size = 20
end
item
Name = 'Phone'
DataType = ftString
Precision = -1
Size = 15
end
item
Name = 'FAX'
DataType = ftString
Precision = -1
Size = 15
end
item
Name = 'TaxRate'
DataType = ftFloat
Precision = -1
end
item
Name = 'Contact'
DataType = ftString
Precision = -1
Size = 20
end
item
Name = 'LastInvoiceDate'
DataType = ftDateTime
Precision = -1
end
item
Name = 'DeliveryMethod'
DataType = ftString
Precision = -1
Size = 8
end>
FilterOptions = []
IndexDefs = <
item
Name = 'Sequential Access Index'
Options = [ixUnique, ixCaseInsensitive, ixExpression]
end
item
Name = 'Primary'
Fields = 'ID'
Options = [ixUnique]
end
item
Name = 'Company'
Fields = 'Company'
Options = [ixCaseInsensitive]
end>
IndexName = 'Primary'
SessionName = 'ffSession1laz'
TableName = 'customer'
left = 366
top = 330
object ffTaCustomerID: TAutoIncField
FieldKind = fkData
FieldName = 'ID'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object ffTaCustomerCompany: TStringField
FieldKind = fkData
FieldName = 'Company'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 30
end
end
end

64
components/flashfiler/examples/LazCustLookup/lazcustlookupmain.pas Normal file
View File

@ -0,0 +1,64 @@
unit LazCustLookupMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
DbCtrls, DBGrids, StdCtrls, ffclreng, fflllgcy, ffdb;
type
{ TForm1 }
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBLookupComboBox1: TDBLookupComboBox;
DBNavigator1: TDBNavigator;
ffClient1: TffClient;
ffDatabase1: TffDatabase;
ffLegacyTransport1: TffLegacyTransport;
FFRemoteServerEngine1: TFFRemoteServerEngine;
ffSession1: TffSession;
ffTable1: TffTable;
ffTable1CustNo: TLongintField;
ffTable1EmpNo: TLongintField;
ffTable1OrderNo: TAutoIncField;
ffTable1SaleDate: TDateTimeField;
ffTable1ShipDate: TDateTimeField;
ffTable1ShipToContact: TStringField;
ffTable1Status: TStringField;
ffTaCustomer: TffTable;
ffTaCustomerCompany: TStringField;
ffTaCustomerID: TAutoIncField;
ffTaCustomer_Proxy: TffTableProxy;
Memo1: TMemo;
StringField1: TStringField;
ToolBar1: TToolBar;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
//Lazarus Form Designer needs "Create order" function!
ffTaCustomer.Active:=true;
ffTable1.Active:=true;
end;
end.

BIN
components/flashfiler/examples/LazEmbeddedServer/FFSTRAN.CFG Normal file
View File

Binary file not shown.

BIN
components/flashfiler/examples/LazEmbeddedServer/LazFFEmbedded.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

87
components/flashfiler/examples/LazEmbeddedServer/LazFFEmbedded.lpi Normal file
View File

@ -0,0 +1,87 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="LazFFEmbedded"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="lazff2"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="LazFFEmbedded.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="lazffembeddedmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="LazFFEmbeddedMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="LazFFEmbedded"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/flashfiler/examples/LazEmbeddedServer/LazFFEmbedded.lpr Normal file
View File

@ -0,0 +1,21 @@
program LazFFEmbedded;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, LazFFEmbeddedMain, lazff2
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
components/flashfiler/examples/LazEmbeddedServer/LazFFEmbedded.res Normal file
View File

Binary file not shown.

BIN
components/flashfiler/examples/LazEmbeddedServer/XXSINFO.FF2 Normal file
View File

Binary file not shown.

1
components/flashfiler/examples/LazEmbeddedServer/_ReadMe.txt Normal file
View File

@ -0,0 +1 @@
FlashFiler-ServerEngine compiles but don't works with fpc so also this example don't works.

89
components/flashfiler/examples/LazEmbeddedServer/lazffembeddedmain.lfm Normal file
View File

@ -0,0 +1,89 @@
object Form1: TForm1
Left = 325
Height = 398
Top = 128
Width = 539
Caption = 'Form1'
ClientHeight = 398
ClientWidth = 539
OnCreate = FormCreate
LCLVersion = '1.6.1.0'
object ToolBar1: TToolBar
Left = 0
Height = 20
Top = 0
Width = 539
AutoSize = True
Caption = 'ToolBar1'
EdgeBorders = []
TabOrder = 0
object DBNavigator1: TDBNavigator
Left = 1
Height = 20
Top = 0
Width = 200
AutoSize = True
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 20
ClientWidth = 200
Options = []
TabOrder = 0
end
end
object DBGrid1: TDBGrid
Left = 0
Height = 378
Top = 20
Width = 539
Align = alClient
Color = clWindow
Columns = <>
DataSource = DataSource1
TabOrder = 1
end
object ffServerEngine1: TffServerEngine
NoAutoSaveCfg = True
ConfigDir = 'D:\AppDev\TDLite\Comps\flashfiler\bin'
left = 88
top = 248
end
object ffClient1: TffClient
ClientName = 'FFClient_69729904'
ServerEngine = ffServerEngine1
left = 154
top = 248
end
object ffSession1: TffSession
ClientName = 'FFClient_69729904'
SessionName = 'FFSession_69795446'
left = 210
top = 248
end
object ffDatabase1: TffDatabase
AliasName = 'D:\AppDev\TDLite\Comps\flashfiler\examples\mythicdb\'
DatabaseName = 'FFDB_282722134'
SessionName = 'FFSession_69795446'
left = 266
top = 248
end
object ffTable1: TffTable
DatabaseName = 'FFDB_282722134'
FieldDefs = <>
FilterOptions = []
SessionName = 'FFSession_69795446'
TableName = 'customer'
left = 322
top = 248
end
object DataSource1: TDataSource
DataSet = ffTable1
left = 372
top = 248
end
end

51
components/flashfiler/examples/LazEmbeddedServer/lazffembeddedmain.pas Normal file
View File

@ -0,0 +1,51 @@
unit LazFFEmbeddedMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
DbCtrls, DBGrids, ffsreng, ffdb;
type
{ TForm1 }
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
ffClient1: TffClient;
ffDatabase1: TffDatabase;
ffServerEngine1: TffServerEngine;
ffSession1: TffSession;
ffTable1: TffTable;
ToolBar1: TToolBar;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
//Embeddedserver don't work in classes.pas the function TReader.ReadString
//raises "Invalid Value for property" because fpc-classes can't handle some string property
//program stops in fflldict.pas procedure TffDataDictionary.ReadFromStream(S : TStream);
ffDatabase1.Connected:=true;
ffTable1.Active:=true;
end;
end.

BIN
components/flashfiler/examples/LazEmbeddedServer_RT/LazFFEmbedded.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

89
components/flashfiler/examples/LazEmbeddedServer_RT/LazFFEmbedded.lpi Normal file
View File

@ -0,0 +1,89 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="LazFFEmbedded"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<TextName Value="CompanyName.ProductName.AppName"/>
<TextDesc Value="Your application description."/>
</XPManifest>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="lazff2"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="LazFFEmbedded.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="lazffembeddedmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="LazFFEmbeddedMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="LazFFEmbedded"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/flashfiler/examples/LazEmbeddedServer_RT/LazFFEmbedded.lpr Normal file
View File

@ -0,0 +1,21 @@
program LazFFEmbedded;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, LazFFEmbeddedMain, lazff2
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
components/flashfiler/examples/LazEmbeddedServer_RT/LazFFEmbedded.res Normal file
View File

Binary file not shown.

3
components/flashfiler/examples/LazEmbeddedServer_RT/_ReadMe.txt Normal file
View File

@ -0,0 +1,3 @@
FlashFiler-ServerEngine compiles but don't works with fpc so also this example don't works.
Copy of LazEmbeddedServer example.

54
components/flashfiler/examples/LazEmbeddedServer_RT/lazffembeddedmain.lfm Normal file
View File

@ -0,0 +1,54 @@
object Form1: TForm1
Left = 325
Height = 398
Top = 128
Width = 539
Caption = 'Form1'
ClientHeight = 398
ClientWidth = 539
OnCreate = FormCreate
LCLVersion = '1.6.3.0'
object ToolBar1: TToolBar
Left = 0
Height = 20
Top = 0
Width = 539
AutoSize = True
Caption = 'ToolBar1'
EdgeBorders = []
TabOrder = 0
object DBNavigator1: TDBNavigator
Left = 1
Height = 20
Top = 0
Width = 200
AutoSize = True
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 20
ClientWidth = 200
Options = []
TabOrder = 0
end
end
object DBGrid1: TDBGrid
Left = 0
Height = 378
Top = 20
Width = 539
Align = alClient
Color = clWindow
Columns = <>
DataSource = DataSource1
TabOrder = 1
end
object DataSource1: TDataSource
left = 372
top = 248
end
end

88
components/flashfiler/examples/LazEmbeddedServer_RT/lazffembeddedmain.pas Normal file
View File

@ -0,0 +1,88 @@
unit LazFFEmbeddedMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
DbCtrls, DBGrids, ffsreng, ffdb;
type
{ TForm1 }
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
ToolBar1: TToolBar;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
ffClient1: TffClient;
ffDatabase1: TffDatabase;
ffServerEngine1: TffServerEngine;
ffSession1: TffSession;
ffTable1: TffTable;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var ServerFolder, DBFolder :string;
begin
//Change Folders to your install
ServerFolder:= 'D:\AppDev\TDLite\Comps\flashfiler\bin\';
DBFolder := 'D:\AppDev\TDLite\Comps\flashfiler\examples\mythicdb\';
ffServerEngine1:= TffServerEngine.Create(self);
ffServerEngine1.ConfigDir := ServerFolder;
//ffServerEngine1.NoAutoSaveCfg:=true;
//ffServerEngine1.CollectGarbage := True;
ffServerEngine1.Startup; //error excepts at 3.run in
//ffsreng.pas
//LIne 6838: Dictionary.ReadFromFile(DataFile, aTI);
ffClient1:= TffClient.Create(self);
ffClient1.ClientName := 'FFClient_69729904';
ffClient1.ServerEngine := ffServerEngine1;
ffSession1:= TffSession.Create(self);
ffSession1.ClientName := 'FFClient_69729904';
ffSession1.SessionName := 'FFSession_69795446';
ffDatabase1:= TffDatabase.Create(self);
ffDatabase1.AliasName := DBFolder;
ffDatabase1.DatabaseName := 'FFDB_282722134'; //-->Starts server if not already started
ffDatabase1.SessionName := 'FFSession_69795446';
ffTable1:= TffTable.Create(self);
ffTable1.DatabaseName := 'FFDB_282722134';
//ffTable1.FieldDefs := <>;
ffTable1.FilterOptions := [];
ffTable1.SessionName := 'FFSession_69795446';
ffTable1.TableName := 'customer';
DataSource1.DataSet:=ffTable1;
//ffServerEngine1.Startup;
//ffClient1.Active:=true;
//ffSession1.Active:=true;
ffDatabase1.Connected:=true;
ffTable1.Active:=true;
end;
end.

13
components/flashfiler/examples/LazExtCust/excust.dpr Normal file
View File

@ -0,0 +1,13 @@
program ExCust;
uses
Forms, Interfaces,
ExCustu in 'ExCustu.pas', lazff2 {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
components/flashfiler/examples/LazExtCust/excust.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

78
components/flashfiler/examples/LazExtCust/excust.lpi Normal file
View File

@ -0,0 +1,78 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="excust"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="lazff2"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="excust.dpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ExCust"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="excust"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

BIN
components/flashfiler/examples/LazExtCust/excust.res Normal file
View File

Binary file not shown.

144
components/flashfiler/examples/LazExtCust/excustu.dfm Normal file
View File

@ -0,0 +1,144 @@
object Form1: TForm1
Left = 200
Top = 108
Width = 548
Height = 333
Caption = 'FlashFiler Example - Customer Data'
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object CustomerGrid: TDBGrid
Left = 0
Top = 30
Width = 540
Height = 257
Align = alClient
DataSource = CustomerData
TabOrder = 0
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 0
Top = 0
Width = 540
Height = 30
DataSource = CustomerData
Align = alTop
Flat = True
TabOrder = 1
end
object ltMain: TffLegacyTransport
Enabled = True
Left = 352
Top = 88
end
object ffRSE: TFFRemoteServerEngine
Transport = ltMain
Left = 320
Top = 88
end
object ffClient: TffClient
ClientName = 'ffClient'
ServerEngine = ffRSE
Left = 320
Top = 56
end
object ffSess: TffSession
ClientName = 'ffClient'
SessionName = 'ExCust'
Left = 352
Top = 56
end
object CustomerTable: TffTable
DatabaseName = 'Tutorial'
IndexName = 'ByID'
SessionName = 'ExCust'
TableName = 'ExCust'
Timeout = 10000
Left = 384
Top = 56
end
object CustomerData: TDataSource
DataSet = CustomerTable
Left = 416
Top = 56
end
object MainMenu1: TMainMenu
Left = 448
Top = 56
object File1: TMenuItem
Caption = '&File'
object Open1: TMenuItem
Caption = '&Open'
OnClick = Open1Click
end
object Close1: TMenuItem
Caption = '&Close'
Enabled = False
OnClick = Close1Click
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = '&Exit'
OnClick = Exit1Click
end
end
object Navigate1: TMenuItem
Caption = '&Navigate'
Enabled = False
object First1: TMenuItem
Caption = '&First'
OnClick = First1Click
end
object Last1: TMenuItem
Caption = '&Last'
OnClick = Last1Click
end
object Next1: TMenuItem
Caption = '&Next'
OnClick = Next1Click
end
object Prior1: TMenuItem
Caption = '&Prior'
OnClick = Prior1Click
end
end
object Edit1: TMenuItem
Caption = '&Edit'
Enabled = False
object Append1: TMenuItem
Caption = '&Append'
OnClick = Append1Click
end
object Insert1: TMenuItem
Caption = '&Insert'
OnClick = Insert1Click
end
object Post1: TMenuItem
Caption = '&Post'
OnClick = Post1Click
end
object Refresh1: TMenuItem
Caption = '&Refresh'
OnClick = Refresh1Click
end
object N2: TMenuItem
Caption = '-'
end
object Cancel1: TMenuItem
Caption = '&Cancel'
OnClick = Cancel1Click
end
end
end
end

172
components/flashfiler/examples/LazExtCust/excustu.pas Normal file
View File

@ -0,0 +1,172 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
unit ExCustu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, ExtCtrls, Menus, Grids, DBGrids, Db, FFDB, FFDBBase, ffllcomm,
fflllgcy, ffllcomp, fflleng, ffsrintm, ffclreng, ffllbase;
type
TForm1 = class(TForm)
ffSess: TffSession;
CustomerTable: TffTable;
CustomerData: TDataSource;
CustomerGrid: TDBGrid;
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Close1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Navigate1: TMenuItem;
First1: TMenuItem;
Last1: TMenuItem;
Next1: TMenuItem;
Prior1: TMenuItem;
Edit1: TMenuItem;
Append1: TMenuItem;
Post1: TMenuItem;
Refresh1: TMenuItem;
Insert1: TMenuItem;
N2: TMenuItem;
Cancel1: TMenuItem;
DBNavigator1: TDBNavigator;
ffClient: TffClient;
ffRSE: TFFRemoteServerEngine;
ltMain: TffLegacyTransport;
procedure Open1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure First1Click(Sender: TObject);
procedure Last1Click(Sender: TObject);
procedure Next1Click(Sender: TObject);
procedure Prior1Click(Sender: TObject);
procedure Append1Click(Sender: TObject);
procedure Post1Click(Sender: TObject);
procedure Refresh1Click(Sender: TObject);
procedure Insert1Click(Sender: TObject);
procedure Cancel1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const
csAlias = 'Tutorial';
{$R *.DFM}
procedure TForm1.Open1Click(Sender: TObject);
begin
CustomerTable.Active := True;
Close1.Enabled := True;
Navigate1.Enabled := True;
Edit1.Enabled := True;
end;
procedure TForm1.Close1Click(Sender: TObject);
begin
CustomerTable.Active := False;
Close1.Enabled := False;
Navigate1.Enabled := False;
Edit1.Enabled := False;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.First1Click(Sender: TObject);
begin
CustomerTable.First;
end;
procedure TForm1.Last1Click(Sender: TObject);
begin
CustomerTable.Last;
end;
procedure TForm1.Next1Click(Sender: TObject);
begin
CustomerTable.Next;
end;
procedure TForm1.Prior1Click(Sender: TObject);
begin
CustomerTable.Prior;
end;
procedure TForm1.Append1Click(Sender: TObject);
begin
CustomerTable.Append;
end;
procedure TForm1.Post1Click(Sender: TObject);
begin
CustomerTable.Post;
end;
procedure TForm1.Refresh1Click(Sender: TObject);
begin
CustomerTable.Refresh;
end;
procedure TForm1.Insert1Click(Sender: TObject);
begin
CustomerTable.Insert;
end;
procedure TForm1.Cancel1Click(Sender: TObject);
begin
CustomerTable.Cancel;
end;
procedure TForm1.FormShow(Sender: TObject);
var
aPath : string;
begin
ffSess.Open;
if not ffSess.IsAlias(csAlias) then begin
aPath := ExtractFilePath(Application.ExeName);
if aPath[Length(aPath)] <> '\' then
aPath := aPath + '\';
{ Path should point to the folder containing the Mythic tables. }
ffSess.AddAlias(csAlias, aPath + '..', False);
end;
end;
end.

BIN
components/flashfiler/examples/LazTffTblIndexNameError/project1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

88
components/flashfiler/examples/LazTffTblIndexNameError/project1.lpi Normal file
View File

@ -0,0 +1,88 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="lazff2"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/flashfiler/examples/LazTffTblIndexNameError/project1.lpr Normal file
View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, lazff2
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
components/flashfiler/examples/LazTffTblIndexNameError/project1.res Normal file
View File

Binary file not shown.

164
components/flashfiler/examples/LazTffTblIndexNameError/unit1.lfm Normal file
View File

@ -0,0 +1,164 @@
object Form1: TForm1
Left = 295
Height = 310
Top = 147
Width = 320
Caption = 'Form1'
ClientHeight = 310
ClientWidth = 320
OnCreate = FormCreate
LCLVersion = '1.6.1.0'
object ToolBar1: TToolBar
Left = 0
Height = 20
Top = 0
Width = 320
AutoSize = True
Caption = 'ToolBar1'
EdgeBorders = []
TabOrder = 0
object DBNavigator1: TDBNavigator
Left = 1
Height = 20
Top = 0
Width = 200
AutoSize = True
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 20
ClientWidth = 200
DataSource = DataSource1
Options = []
TabOrder = 0
end
end
object DBGrid1: TDBGrid
Left = 0
Height = 290
Top = 20
Width = 320
Align = alClient
Color = clWindow
Columns = <>
DataSource = DataSource1
TabOrder = 1
end
object ffLegacyTransport1: TffLegacyTransport
Enabled = True
ServerName = 'Local server'
left = 28
top = 12
end
object FFRemoteServerEngine1: TFFRemoteServerEngine
Transport = ffLegacyTransport1
left = 28
top = 70
end
object ffClient1: TffClient
Active = True
ClientName = 'ffClient1'
ServerEngine = FFRemoteServerEngine1
TimeOut = 100
left = 28
top = 122
end
object ffSession1: TffSession
Active = True
ClientName = 'ffClient1'
SessionName = 'ffSession1sa'
TimeOut = 100
left = 26
top = 174
end
object ffDatabase1: TffDatabase
AliasName = 'Tutorial'
Connected = True
DatabaseName = 'ffDbDebug'
SessionName = 'ffSession1sa'
Timeout = 1000
left = 76
top = 176
end
object ffTable1: TffTable
DatabaseName = 'ffDbDebug'
FieldDefs = <
item
Name = 'CustomerID'
DataType = ftInteger
Precision = -1
end
item
Name = 'FirstName'
DataType = ftString
Precision = -1
Size = 25
end
item
Name = 'LastName'
DataType = ftString
Precision = -1
Size = 25
end
item
Name = 'Address'
DataType = ftString
Precision = -1
Size = 25
end
item
Name = 'City'
DataType = ftString
Precision = -1
Size = 25
end
item
Name = 'State'
DataType = ftString
Precision = -1
Size = 25
end
item
Name = 'Zip'
DataType = ftString
Precision = -1
Size = 10
end>
FilterOptions = []
IndexDefs = <
item
Name = 'Sequential Access Index'
Options = [ixUnique, ixCaseInsensitive, ixExpression]
end
item
Name = 'ByID'
Fields = 'CustomerID'
Options = [ixUnique]
end
item
Name = 'ByName'
Fields = 'LastName'
Options = [ixCaseInsensitive]
end
item
Name = 'ByState'
Fields = 'State'
Options = [ixCaseInsensitive]
end>
IndexName = 'ByID'
SessionName = 'ffSession1sa'
TableName = 'excust'
Timeout = 100
left = 32
top = 234
end
object DataSource1: TDataSource
DataSet = ffTable1
left = 239
top = 32
end
end

81
components/flashfiler/examples/LazTffTblIndexNameError/unit1.pas Normal file
View File

@ -0,0 +1,81 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
ComCtrls, DbCtrls, DBGrids, fflllgcy, ffsreng, ffclreng, ffdb;
type
{ TForm1 }
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
ffClient1: TffClient;
ffDatabase1: TffDatabase;
ffLegacyTransport1: TffLegacyTransport;
FFRemoteServerEngine1: TFFRemoteServerEngine;
ffSession1: TffSession;
ffTable1: TffTable;
ToolBar1: TToolBar;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
// 2016.04.25 SOLVED (pred(0)=0 error look at ffdb.TffBaseTable.dsGetIndexInfo;)
// if TffTable.IndexName='' then TffTable.Active:=True; causes exception!
ffTable1.IndexName:='';//<-- 1.
//ffTable1.IndexName:='Sequential Access Index';//test
ffTable1.Active:=True; //<-- 2. Exception
Caption:='test';
{Result of one Debug session
ffllbase.pas
first -->
Zeile 6227
rwpGate.Lock
(rwpGate is TffPadLock)
then -->
Row 6377
Called very often (enless? until Timeout?)
procedure TffPadLock.Lock;
begin
if IsMultiThread then begin
EnterCriticalSection(plCritSect);
inc(plCount);
end;
end;
Forget next lines, they are secundary errors (timeout, while debugging) :
Current debug run (stop, trace...) i get this error:
"Timed out waitig for reply"
then ---> ffdtmsq.pas
row 195
aTail^.dmnNext := aNode;
"aTail is nil"
}
end;
end.

13
components/flashfiler/examples/Lazffsql/excust.dpr Normal file
View File

@ -0,0 +1,13 @@
program ExCust;
uses
Forms, Interfaces,
ExCustu in 'ExCustu.pas', lazff2 {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

BIN
components/flashfiler/examples/Lazffsql/excust.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

77
components/flashfiler/examples/Lazffsql/excust.lpi Normal file
View File

@ -0,0 +1,77 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="excust"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="lazff2"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="excust.dpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="excust"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

BIN
components/flashfiler/examples/Lazffsql/excust.res Normal file
View File

Binary file not shown.

208
components/flashfiler/examples/Lazffsql/excustu.dfm Normal file
View File

@ -0,0 +1,208 @@
object Form1: TForm1
Left = 224
Height = 287
Top = 96
Width = 540
Caption = 'FlashFiler Example - Customer Data'
ClientHeight = 268
ClientWidth = 540
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Menu = MainMenu1
OnShow = FormShow
LCLVersion = '1.6.1.0'
object ToolBar1: TToolBar
Left = 0
Height = 23
Top = 0
Width = 540
AutoSize = True
ButtonHeight = 21
ButtonWidth = 55
Caption = 'ToolBar1'
ShowCaptions = True
TabOrder = 0
object TlBtnRunQuery: TToolButton
Left = 1
Top = 2
Caption = 'RunQuery'
ImageIndex = 0
OnClick = TlBtnRunQueryClick
end
object ToolButton2: TToolButton
Left = 57
Height = 21
Top = 2
Width = 8
Caption = 'ToolButton2'
ImageIndex = 1
Style = tbsSeparator
end
object DBNavigator1: TDBNavigator
Left = 65
Height = 21
Top = 2
Width = 250
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 21
ClientWidth = 250
DataSource = CustomerData
Flat = True
Options = []
TabOrder = 0
end
end
object CustomerGrid: TDBGrid
Left = 0
Height = 156
Top = 112
Width = 540
Align = alClient
Color = clWindow
Columns = <>
DataSource = CustomerData
TabOrder = 1
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
end
object Memo1: TMemo
Left = 0
Height = 89
Top = 23
Width = 540
Align = alTop
Lines.Strings = (
'select * from ExCust where State=''NC'' AND CustomerID<50'
)
OnKeyDown = Memo1KeyDown
TabOrder = 2
end
object ltMain: TffLegacyTransport
Enabled = True
ServerName = 'Local server'
left = 352
top = 88
end
object ffRSE: TFFRemoteServerEngine
Transport = ltMain
left = 320
top = 88
end
object ffClient: TffClient
ClientName = 'ffClient'
ServerEngine = ffRSE
left = 320
top = 56
end
object ffSess: TffSession
ClientName = 'ffClient'
SessionName = 'ExCust'
left = 352
top = 56
end
object CustomerTable: TffTable
DatabaseName = 'Tutorial'
FieldDefs = <>
FilterOptions = []
IndexName = 'ByID'
SessionName = 'ExCust'
TableName = 'ExCust'
Timeout = 10000
left = 420
top = 124
end
object CustomerData: TDataSource
DataSet = ffQuery1
left = 416
top = 56
end
object MainMenu1: TMainMenu
left = 448
top = 56
object File1: TMenuItem
Caption = '&File'
object Open1: TMenuItem
Caption = '&Open'
OnClick = Open1Click
end
object Close1: TMenuItem
Caption = '&Close'
Enabled = False
OnClick = Close1Click
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = '&Exit'
OnClick = Exit1Click
end
end
object Navigate1: TMenuItem
Caption = '&Navigate'
Enabled = False
object First1: TMenuItem
Caption = '&First'
OnClick = First1Click
end
object Last1: TMenuItem
Caption = '&Last'
OnClick = Last1Click
end
object Next1: TMenuItem
Caption = '&Next'
OnClick = Next1Click
end
object Prior1: TMenuItem
Caption = '&Prior'
OnClick = Prior1Click
end
end
object Edit1: TMenuItem
Caption = '&Edit'
Enabled = False
object Append1: TMenuItem
Caption = '&Append'
OnClick = Append1Click
end
object Insert1: TMenuItem
Caption = '&Insert'
OnClick = Insert1Click
end
object Post1: TMenuItem
Caption = '&Post'
OnClick = Post1Click
end
object Refresh1: TMenuItem
Caption = '&Refresh'
OnClick = Refresh1Click
end
object N2: TMenuItem
Caption = '-'
end
object Cancel1: TMenuItem
Caption = '&Cancel'
OnClick = Cancel1Click
end
end
end
object ffQuery1: TffQuery
DatabaseName = 'Tutorial'
FilterOptions = []
SessionName = 'ExCust'
SQL.Strings = (
'select * from ExCust where State=''NC'' AND CustomerID<50'
)
left = 382
top = 38
end
end

60
components/flashfiler/examples/Lazffsql/excustu.lrs Normal file
View File

@ -0,0 +1,60 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#224#0#6'Height'#3#31#1#3'Top'#2'`'#5'Widt'
+'h'#3#28#2#7'Caption'#6'"FlashFiler Example - Customer Data'#12'ClientHeight'
+#3#12#1#11'ClientWidth'#3#28#2#5'Color'#7#9'clBtnFace'#10'Font.Color'#7#12'c'
+'lWindowText'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#4'Menu'
+#7#9'MainMenu1'#6'OnShow'#7#8'FormShow'#10'LCLVersion'#6#7'1.6.1.0'#0#8'TToo'
+'lBar'#8'ToolBar1'#4'Left'#2#0#6'Height'#2#23#3'Top'#2#0#5'Width'#3#28#2#8'A'
+'utoSize'#9#12'ButtonHeight'#2#21#11'ButtonWidth'#2'7'#7'Caption'#6#8'ToolBa'
+'r1'#12'ShowCaptions'#9#8'TabOrder'#2#0#0#11'TToolButton'#13'TlBtnRunQuery'#4
+'Left'#2#1#3'Top'#2#2#7'Caption'#6#8'RunQuery'#10'ImageIndex'#2#0#7'OnClick'
+#7#18'TlBtnRunQueryClick'#0#0#11'TToolButton'#11'ToolButton2'#4'Left'#2'9'#6
+'Height'#2#21#3'Top'#2#2#5'Width'#2#8#7'Caption'#6#11'ToolButton2'#10'ImageI'
+'ndex'#2#1#5'Style'#7#12'tbsSeparator'#0#0#12'TDBNavigator'#12'DBNavigator1'
+#4'Left'#2'A'#6'Height'#2#21#3'Top'#2#2#5'Width'#3#250#0#10'BevelOuter'#7#6
+'bvNone'#29'ChildSizing.EnlargeHorizontal'#7#14'crsScaleChilds'#27'ChildSizi'
+'ng.EnlargeVertical'#7#14'crsScaleChilds'#28'ChildSizing.ShrinkHorizontal'#7
+#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'C'
+'hildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.Contr'
+'olsPerLine'#2'd'#12'ClientHeight'#2#21#11'ClientWidth'#3#250#0#10'DataSourc'
+'e'#7#12'CustomerData'#4'Flat'#9#7'Options'#11#0#8'TabOrder'#2#0#0#0#0#7'TDB'
+'Grid'#12'CustomerGrid'#4'Left'#2#0#6'Height'#3#156#0#3'Top'#2'p'#5'Width'#3
+#28#2#5'Align'#7#8'alClient'#5'Color'#7#8'clWindow'#7'Columns'#14#0#10'DataS'
+'ource'#7#12'CustomerData'#8'TabOrder'#2#1#15'TitleFont.Color'#7#12'clWindow'
+'Text'#16'TitleFont.Height'#2#245#14'TitleFont.Name'#6#13'MS Sans Serif'#0#0
+#5'TMemo'#5'Memo1'#4'Left'#2#0#6'Height'#2'Y'#3'Top'#2#23#5'Width'#3#28#2#5
+'Align'#7#5'alTop'#13'Lines.Strings'#1#6'8select * from ExCust where State='
+'''NC'' AND CustomerID<50'#0#9'OnKeyDown'#7#12'Memo1KeyDown'#8'TabOrder'#2#2
+#0#0#18'TffLegacyTransport'#6'ltMain'#7'Enabled'#9#10'ServerName'#6#12'Local'
+' server'#4'left'#3'`'#1#3'top'#2'X'#0#0#21'TFFRemoteServerEngine'#5'ffRSE'#9
+'Transport'#7#6'ltMain'#4'left'#3'@'#1#3'top'#2'X'#0#0#9'TffClient'#8'ffClie'
+'nt'#10'ClientName'#6#8'ffClient'#12'ServerEngine'#7#5'ffRSE'#4'left'#3'@'#1
+#3'top'#2'8'#0#0#10'TffSession'#6'ffSess'#10'ClientName'#6#8'ffClient'#11'Se'
+'ssionName'#6#6'ExCust'#4'left'#3'`'#1#3'top'#2'8'#0#0#8'TffTable'#13'Custom'
+'erTable'#12'DatabaseName'#6#8'Tutorial'#9'FieldDefs'#14#0#13'FilterOptions'
+#11#0#9'IndexName'#6#4'ByID'#11'SessionName'#6#6'ExCust'#9'TableName'#6#6'Ex'
+'Cust'#7'Timeout'#3#16''''#4'left'#3#164#1#3'top'#2'|'#0#0#11'TDataSource'#12
+'CustomerData'#7'DataSet'#7#8'ffQuery1'#4'left'#3#160#1#3'top'#2'8'#0#0#9'TM'
+'ainMenu'#9'MainMenu1'#4'left'#3#192#1#3'top'#2'8'#0#9'TMenuItem'#5'File1'#7
+'Caption'#6#5'&File'#0#9'TMenuItem'#5'Open1'#7'Caption'#6#5'&Open'#7'OnClick'
+#7#10'Open1Click'#0#0#9'TMenuItem'#6'Close1'#7'Caption'#6#6'&Close'#7'Enable'
+'d'#8#7'OnClick'#7#11'Close1Click'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1'-'#0
+#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'&Exit'#7'OnClick'#7#10'Exit1Click'#0
+#0#0#9'TMenuItem'#9'Navigate1'#7'Caption'#6#9'&Navigate'#7'Enabled'#8#0#9'TM'
+'enuItem'#6'First1'#7'Caption'#6#6'&First'#7'OnClick'#7#11'First1Click'#0#0#9
+'TMenuItem'#5'Last1'#7'Caption'#6#5'&Last'#7'OnClick'#7#10'Last1Click'#0#0#9
+'TMenuItem'#5'Next1'#7'Caption'#6#5'&Next'#7'OnClick'#7#10'Next1Click'#0#0#9
+'TMenuItem'#6'Prior1'#7'Caption'#6#6'&Prior'#7'OnClick'#7#11'Prior1Click'#0#0
+#0#9'TMenuItem'#5'Edit1'#7'Caption'#6#5'&Edit'#7'Enabled'#8#0#9'TMenuItem'#7
+'Append1'#7'Caption'#6#7'&Append'#7'OnClick'#7#12'Append1Click'#0#0#9'TMenuI'
+'tem'#7'Insert1'#7'Caption'#6#7'&Insert'#7'OnClick'#7#12'Insert1Click'#0#0#9
+'TMenuItem'#5'Post1'#7'Caption'#6#5'&Post'#7'OnClick'#7#10'Post1Click'#0#0#9
+'TMenuItem'#8'Refresh1'#7'Caption'#6#8'&Refresh'#7'OnClick'#7#13'Refresh1Cli'
+'ck'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#7'Cancel1'#7
+'Caption'#6#7'&Cancel'#7'OnClick'#7#12'Cancel1Click'#0#0#0#0#8'TffQuery'#8'f'
+'fQuery1'#12'DatabaseName'#6#8'Tutorial'#13'FilterOptions'#11#0#11'SessionNa'
+'me'#6#6'ExCust'#11'SQL.Strings'#1#6'8select * from ExCust where State=''NC'
+''' AND CustomerID<50'#0#4'left'#3'~'#1#3'top'#2'&'#0#0#0
]);

194
components/flashfiler/examples/Lazffsql/excustu.pas Normal file
View File

@ -0,0 +1,194 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
unit ExCustu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, ExtCtrls, Menus, Grids, DBGrids, Db, FFDB, FFDBBase, ffllcomm,
fflllgcy, ffllcomp, fflleng, ffsrintm, ffclreng, ffllbase, StdCtrls, ToolWin,
ComCtrls;
type
TForm1 = class(TForm)
ffSess: TffSession;
CustomerTable: TffTable;
CustomerData: TDataSource;
CustomerGrid: TDBGrid;
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Close1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Navigate1: TMenuItem;
First1: TMenuItem;
Last1: TMenuItem;
Next1: TMenuItem;
Prior1: TMenuItem;
Edit1: TMenuItem;
Append1: TMenuItem;
Post1: TMenuItem;
Refresh1: TMenuItem;
Insert1: TMenuItem;
N2: TMenuItem;
Cancel1: TMenuItem;
DBNavigator1: TDBNavigator;
ffClient: TffClient;
ffRSE: TFFRemoteServerEngine;
ltMain: TffLegacyTransport;
ToolBar1: TToolBar;
Memo1: TMemo;
ffQuery1: TffQuery;
TlBtnRunQuery: TToolButton;
ToolButton2: TToolButton;
procedure Open1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure First1Click(Sender: TObject);
procedure Last1Click(Sender: TObject);
procedure Next1Click(Sender: TObject);
procedure Prior1Click(Sender: TObject);
procedure Append1Click(Sender: TObject);
procedure Post1Click(Sender: TObject);
procedure Refresh1Click(Sender: TObject);
procedure Insert1Click(Sender: TObject);
procedure Cancel1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TlBtnRunQueryClick(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const
csAlias = 'Tutorial';
{$R *.DFM}
procedure TForm1.Open1Click(Sender: TObject);
begin
ffQuery1.Open; //soner: CustomerTable.Active := True;
Close1.Enabled := True;
Navigate1.Enabled := True;
Edit1.Enabled := True;
end;
procedure TForm1.Close1Click(Sender: TObject);
begin
ffQuery1.Close; //soner: CustomerTable.Active := False;
Close1.Enabled := False;
Navigate1.Enabled := False;
Edit1.Enabled := False;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.First1Click(Sender: TObject);
begin
CustomerTable.First;
end;
procedure TForm1.Last1Click(Sender: TObject);
begin
CustomerTable.Last;
end;
procedure TForm1.Next1Click(Sender: TObject);
begin
CustomerTable.Next;
end;
procedure TForm1.Prior1Click(Sender: TObject);
begin
CustomerTable.Prior;
end;
procedure TForm1.Append1Click(Sender: TObject);
begin
CustomerTable.Append;
end;
procedure TForm1.Post1Click(Sender: TObject);
begin
CustomerTable.Post;
end;
procedure TForm1.Refresh1Click(Sender: TObject);
begin
CustomerTable.Refresh;
end;
procedure TForm1.Insert1Click(Sender: TObject);
begin
CustomerTable.Insert;
end;
procedure TForm1.Cancel1Click(Sender: TObject);
begin
CustomerTable.Cancel;
end;
procedure TForm1.FormShow(Sender: TObject);
var
aPath : string;
begin
ffSess.Open;
if not ffSess.IsAlias(csAlias) then begin
aPath := ExtractFilePath(Application.ExeName);
if aPath[Length(aPath)] <> '\' then
aPath := aPath + '\';
{ Path should point to the folder containing the Mythic tables. }
ffSess.AddAlias(csAlias, aPath + '..', False);
end;
end;
procedure TForm1.TlBtnRunQueryClick(Sender: TObject);
begin
//soner
ffQuery1.SQL.Text:=Memo1.Lines.Text;
ffQuery1.Open;
end;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=VK_RETURN)and(ssCtrl in Shift) then TlBtnRunQuery.Click;
end;
end.

69
components/flashfiler/packages/lazff2.lpk Normal file
View File

@ -0,0 +1,69 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="lazff2"/>
<Type Value="RunAndDesignTime"/>
<AddToProjectUsesSection Value="True"/>
<Author Value="Soner A.(Lazarus Convert)"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="..\sourcelaz"/>
<OtherUnitFiles Value="..\sourcelaz"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Description Value="TurboPower FlashFiler2 for Lazarus"/>
<License Value="Same as TurboPower FlashFIler2 from SourceForge"/>
<Files Count="7">
<Item1>
<Filename Value="..\sourcelaz\ffclreg.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="ffclreg"/>
</Item1>
<Item2>
<Filename Value="..\sourcelaz\ffclfldg.pas"/>
<UnitName Value="ffclfldg"/>
</Item2>
<Item3>
<Filename Value="..\sourcelaz\ffabout.pas"/>
<UnitName Value="ffabout"/>
</Item3>
<Item4>
<Filename Value="..\sourcelaz\ffclexps.pas"/>
<UnitName Value="ffclexps"/>
</Item4>
<Item5>
<Filename Value="..\sourcelaz\ffllgrid.pas"/>
<UnitName Value="ffllgrid"/>
</Item5>
<Item6>
<Filename Value="..\sourcelaz\ffclsqle.pas"/>
<UnitName Value="ffclsqle"/>
</Item6>
<Item7>
<Filename Value="..\sourcelaz\ffllexcp.pas"/>
<UnitName Value="ffllexcp"/>
</Item7>
</Files>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="IDEIntf"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

22
components/flashfiler/packages/lazff2.pas Normal file
View File

@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit lazff2;
interface
uses
ffclreg, ffclfldg, ffabout, ffclexps, ffllgrid, ffclsqle, ffllexcp,
LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('ffclreg', @ffclreg.Register);
end;
initialization
RegisterPackage('lazff2', @Register);
end.

2075
components/flashfiler/sourcelaz/#NotUsedMore/lazffdelphi1.pas Normal file
View File

File diff suppressed because it is too large Load Diff

620
components/flashfiler/sourcelaz/#NotUsedMore/lazffdelphi2.pas Normal file
View File

@ -0,0 +1,620 @@
{ Only unit lazffdelphi1.pas is using this unit.
!!! CODE TAKEN FROM DELPHI7 - BORLAND CODE !!!
}
{ *************************************************************************** }
{ }
{ Kylix and Delphi Cross-Platform Visual Component Library }
{ }
{ Copyright (c) 1995, 2001 Borland Software Corporation }
{ }
{ *************************************************************************** }
{$I ffdefine.inc}
//Originalname: unit SqlTimSt;
//called only from lazffdelphi1
unit lazffdelphi2;
// need to implement CastOLE, dispatch and stream (from Eddie?)
interface
uses Variants;
type
{ TSQLTimeStamp }
PSQLTimeStamp = ^TSQLTimeStamp;
TSQLTimeStamp = packed record
Year: SmallInt;
Month: Word;
Day: Word;
Hour: Word;
Minute: Word;
Second: Word;
Fractions: LongWord;
end;
function StrToSQLTimeStamp(const S: string): TSQLTimeStamp;
function VarToSQLTimeStamp(const aValue: Variant): TSQLTimeStamp;
implementation
uses
{VarUtils, }SysUtils, DateUtils, SysConst, TypInfo, Classes, {$IFDEF MSWINDOWS}Windows{$ENDIF}{$IFDEF LINUX}Types, Libc{$ENDIF};
resourcestring
//FROM DBConsts.pas ================================
SCouldNotParseTimeStamp = 'Could not parse time stamp.';
SInvalidSqlTimeStamp = 'Invalied sql time stamp.';
//END FROM DBConsts.pas ================================
const
NullSQLTimeStamp: TSQLTimeStamp = (Year: 0; Month: 0; Day: 0; Hour: 0; Minute: 0; Second: 0; Fractions: 0); //soner this was in implementation part
IncrementAmount: array[Boolean] of Integer = (1, -1);
type
{ TSQLTimeStampVariantType }
TSQLTimeStampVariantType = class(TPublishableVariantType)
protected
function GetInstance(const V: TVarData): TObject; override;
public
procedure Clear(var V: TVarData); override;
procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
procedure Cast(var Dest: TVarData; const Source: TVarData); override;
procedure CastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType); override;
procedure BinaryOp(var Left: TVarData; const Right: TVarData; const Operator: TVarOp); override;
procedure Compare(const Left, Right: TVarData; var Relationship: TVarCompareResult); override;
end;
var
{ SQLTimeStamp that the complex variant points to }
SQLTimeStampVariantType: TSQLTimeStampVariantType = nil;
type
{ TSQLTimeStampData }
TSQLTimeStampData = class(TPersistent)
private
FDateTime: TSQLTimeStamp;
function GetAsDateTime: TDateTime;
function GetAsString: string;
procedure SetAsString(const Value: string);
procedure SetAsDateTime(const Value: TDateTime);
procedure AdjustMonths(Reverse: Boolean);
procedure AdjustDays(Reverse: Boolean);
procedure AdjustHours(Reverse: Boolean);
procedure AdjustMinutes(Reverse: Boolean);
procedure AdjustSeconds(Reverse: Boolean);
function DaysInMonth: Integer;
function GetIsBlank: Boolean;
procedure SetDay(const Value: Word);
procedure SetFractions(const Value: LongWord);
procedure SetHour(const Value: Word);
procedure SetMinute(const Value: Word);
procedure SetMonth(const Value: Word);
procedure SetSecond(const Value: Word);
procedure SetYear(const Value: SmallInt);
protected
procedure AdjustDate(Reverse: Boolean);
property IsBlank: Boolean read GetIsBlank;
public
// the many ways to create
constructor Create(const AValue: SmallInt); overload;
constructor Create(const AValue: Integer); overload;
constructor Create(const AValue: TDateTime); overload;
constructor Create(const AText: string); overload;
constructor Create(const ASQLTimeStamp: TSQLTimeStamp); overload;
constructor Create(const ASource: TSQLTimeStampData); overload;
// access to the private bits
property DateTime: TSQLTimeStamp read FDateTime write FDateTime;
// non-destructive operations
// check this one!
function Compare(const Value: TSQLTimeStampData): TVarCompareResult;
// destructive operations
procedure DoAdd(const ADateTime: TSQLTimeStampData); overload;
procedure DoSubtract(const ADateTime: TSQLTimeStampData); overload;
// property access
published
// conversion
property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
property AsString: string read GetAsString write SetAsString;
property Day: Word read FDateTime.Day write SetDay;
property Fractions: LongWord read FDateTime.Fractions write SetFractions;
property Hour: Word read FDateTime.Hour write SetHour;
property Minute: Word read FDateTime.Minute write SetMinute;
property Month: Word read FDateTime.Month write SetMonth;
property Second: Word read FDateTime.Second write SetSecond;
property Year: SmallInt read FDateTime.Year write SetYear;
end;
{ Helper record that helps crack open TSQLTimeStampObject }
TSQLTimeStampVarData = packed record
VType: TVarType;
Reserved1, Reserved2, Reserved3: Word;
VDateTime: TSQLTimeStampData;
Reserved4: DWord;
end;
function IsSQLTimeStampBlank(const TimeStamp: TSQLTimeStamp): Boolean;
begin
Result := (TimeStamp.Year = 0) and
(TimeStamp.Month = 0) and
(TimeStamp.Day = 0) and
(TimeStamp.Hour = 0) and
(TimeStamp.Minute = 0) and
(TimeStamp.Second = 0) and
(TimeStamp.Fractions = 0);
end;
// soner helper functions from bottom ------------------------------------
// I moved only used functions from bottom to here and deleted unused
function SQLTimeStampToDateTime(const DateTime: TSQLTimeStamp): TDateTime;
begin
if IsSQLTimeStampBlank(DateTime) then
Result := 0
else with DateTime do
begin
Result := EncodeDate(Year, Month, Day);
if Result >= 0 then
Result := Result + EncodeTime(Hour, Minute, Second, Fractions)
else
Result := Result - EncodeTime(Hour, Minute, Second, Fractions);
end;
end;
function DateTimeToSQLTimeStamp(const DateTime: TDateTime): TSQLTimeStamp;
var
FFractions, FYear: Word;
begin
with Result do
begin
DecodeDate(DateTime, FYear, Month, Day);
Year := FYear;
DecodeTime(DateTime, Hour, Minute, Second, FFractions);
Fractions := FFractions;
end;
end;
function SQLTimeStampToStr(const Format: string;
DateTime: TSQLTimeStamp): string;
var
FTimeStamp: TDateTime;
begin
FTimeStamp := SqlTimeStampToDateTime(DateTime);
DateTimeToString(Result, Format, FTimeStamp);
end;
function IsSqlTimeStampValid(const ts: TSQLTimeStamp): Boolean;
begin
if (ts.Month > 12) or (ts.Day > DaysInAMonth(ts.Year, ts.Month)) or
(ts.Hour > 23) or (ts.Minute > 59) or (ts.Second > 59) then
Result := False
else
Result := True;
end;
function TryStrToSQLTimeStamp(const S: string; var TimeStamp: TSQLTimeStamp): Boolean;
var
DT: TDateTime;
begin
Result := TryStrToDateTime(S, DT);
if Result then
begin
TimeStamp := DateTimeToSQLTimeStamp(DT);
Result := IsSqlTimeStampValid(TimeStamp);
end;
if not Result then
TimeStamp := NullSQLTimeStamp;
end;
procedure CheckSqlTimeStamp(const ASQLTimeStamp: TSQLTimeStamp);
begin // only check if not an empty timestamp
if ASQLTimeStamp.Year + ASQLTimeStamp.Month + ASQLTimeStamp.day +
ASQLTimeStamp.Hour + ASQLTimeStamp.Minute + ASQLTimeStamp.Second > 0 then
begin
if ASQLTimeStamp.Year + ASQLTimeStamp.Month + ASQLTimeStamp.Day > 0 then
if (ASQLTimeStamp.Year = 0) or (ASQLTimeStamp.Month = 0) or
(ASQLTimeStamp.Day =0) or (ASQLTimeStamp.Month > 31) or (ASQLTimeStamp.Day >
DaysInAMonth(ASQLTimeStamp.Year,ASQLTimeStamp.Month)) then
raise EConvertError.Create(SInvalidSQLTimeStamp);
if ASQLTimeStamp.Hour + ASQLTimeStamp.Minute + ASQLTimeStamp.Second > 0 then
if (ASQLTimeStamp.Hour > 23) or (ASQLTimeStamp.Second > 59) or
(ASQLTimeStamp.Minute > 59) then
raise EConvertError.Create(SInvalidSQLTimeStamp);
end;
end;
// ------soner helper functions from bottom--------------------------------
{ TSQLTimeStampData }
function TSQLTimeStampData.GetIsBlank: Boolean;
begin
Result := IsSQLTimeStampBlank(FDateTime);
end;
// Adjust for Month > 12 or < 1
procedure TSQLTimeStampData.AdjustMonths(Reverse: Boolean);
const
AdjustAmt: array[Boolean] of Integer = (-12, 12);
begin
while (FDateTime.Month < 1) or(FDateTime.Month > 12) do
begin
Inc(FDateTime.Year, IncrementAmount[Reverse]);
Inc(FDateTime.Month, AdjustAmt[Reverse]);
end;
end;
// Adjust for Days > 28/30/31 or < 1
procedure TSQLTimeStampData.AdjustDays(Reverse: Boolean);
var
Days: Integer;
begin
Days := DaysInMonth;
while (FDateTime.Day < 1) or (FDateTime.Day > Days) do
begin
Inc(FDateTime.Month, IncrementAmount[Reverse]);
if Reverse then
Dec(FDateTime.Day, Days)
else
Inc(FDateTime.Day, Days);
AdjustMonths(Reverse);
Days := DaysInMonth;
end;
end;
// Adjust for Hours over 23 or less than 0
procedure TSQLTimeStampData.AdjustHours(Reverse: Boolean);
const
AdjustAmt: array[Boolean] of Integer = (-24, 24);
begin
while (FDateTime.Hour > 23) or (Integer(FDateTime.Hour) < 0) do
begin
Inc(FDateTime.Day, IncrementAmount[Reverse]);
Inc(FDateTime.Hour, AdjustAmt[Reverse]);
AdjustDays(Reverse);
end;
end;
// Adjust Minutes for Hours over 59 or less than 0
procedure TSQLTimeStampData.AdjustMinutes(Reverse: Boolean);
const
AdjustAmt: array[Boolean] of Integer = (-60, 60);
begin
while (FDateTime.Minute > 59) or (Integer(FDateTime.Minute) < 0) do
begin
Inc(FDateTime.Hour, IncrementAmount[Reverse]);
Inc(FDateTime.Minute, AdjustAmt[Reverse]);
AdjustHours(Reverse);
end;
end;
// Adjust Seconds for Hours over 59 or less than 0
procedure TSQLTimeStampData.AdjustSeconds(Reverse: Boolean);
const
AdjustAmt: array[Boolean] of Integer = (-60, 60);
begin
while (FDateTime.Second > 59) or (Integer(FDateTime.Second) < 0) do
begin
Inc(FDateTime.Minute, IncrementAmount[Reverse]);
Inc(FDateTime.Second, AdjustAmt[Reverse]);
AdjustMinutes(Reverse);
end;
end;
procedure TSQLTimeStampData.AdjustDate(Reverse: Boolean);
begin
if Reverse then
begin
AdjustSeconds(Reverse);
AdjustMinutes(Reverse);
AdjustHours(Reverse);
AdjustDays(Reverse);
AdjustMonths(Reverse);
end else
begin
AdjustMonths(Reverse);
AdjustDays(Reverse);
AdjustHours(Reverse);
AdjustMinutes(Reverse);
AdjustSeconds(Reverse);
end;
end;
function TSQLTimeStampData.DaysInMonth: Integer;
begin
Result := DaysInAMonth(DateTime.Year, DateTime.Month);
end;
procedure TSQLTimeStampData.DoSubtract(const ADateTime: TSQLTimeStampData);
begin
Dec(FDateTime.Year, ADateTime.Year);
Dec(FDateTime.Hour, ADateTime.Month);
Dec(FDateTime.Day, ADateTime.Day);
Dec(FDateTime.Hour, ADateTime.Hour);
Dec(FDateTime.Minute, ADateTime.Minute);
Dec(FDateTime.Second, ADateTime.Second);
Dec(FDateTime.Fractions, ADateTime.Fractions);
AdjustDate(True);
end;
procedure TSQLTimeStampData.DoAdd(const ADateTime: TSQLTimeStampData);
begin
if not IsBlank then
begin
Inc(FDateTime.Year, ADateTime.Year);
Inc(FDateTime.Hour, ADateTime.Month);
Inc(FDateTime.Day, ADateTime.Day);
Inc(FDateTime.Hour, ADateTime.Hour);
Inc(FDateTime.Minute, ADateTime.Minute);
Inc(FDateTime.Second, ADateTime.Second);
Inc(FDateTime.Fractions, ADateTime.Fractions);
AdjustDate(False);;
end;
end;
function TSQLTimeStampData.Compare(const Value: TSQLTimeStampData): TVarCompareResult;
var
Status: Integer;
begin
Status := FDateTime.Year - Value.Year;
if Status = 0 then
Status := FDateTime.Month - Value.Month;
if Status = 0 then
Status := FDateTime.Day - Value.Day;
if Status = 0 then
Status := FDateTime.Hour - Value.Hour;
if Status = 0 then
Status := FDateTime.Hour - Value.Hour;
if Status = 0 then
Status := FDateTime.Minute - Value.Minute;
if Status = 0 then
Status := FDateTime.Second - Value.Second;
if Status = 0 then
Status := FDateTime.Fractions - Value.Fractions;
if Status = 0 then
Result := crEqual
else
if Status > 0 then
Result := crGreaterThan
else
Result := crLessThan;
end;
function TSQLTimeStampData.GetAsString: string;
begin
Result := SQLTimeStampToStr('', FDateTime);
end;
function TSQLTimeStampData.GetAsDateTime: TDateTime;
begin
Result := SQLTimeStampToDateTime(FDateTime);
end;
procedure TSQLTimeStampData.SetAsString(const Value: string);
begin
FDateTime := StrToSQLTimeStamp(Value);
end;
procedure TSQLTimeStampData.SetAsDateTime(const Value: TDateTime);
begin
FDateTime := DateTimeToSQLTimeStamp(Value);
end;
constructor TSQLTimeStampData.Create(const AValue: Integer);
begin
inherited Create;
FDateTime := NullSQLTimeStamp;
FDateTime.Day := AValue;
end;
constructor TSQLTimeStampData.Create(const AValue: SmallInt);
begin
inherited Create;
FDateTime := NullSQLTimeStamp;
FDateTime.Day := AValue;
end;
constructor TSQLTimeStampData.Create(const AValue: TDateTime);
begin
inherited Create;
FDateTime := DateTimeToSqlTimeStamp(AValue);
end;
constructor TSQLTimeStampData.Create(const AText: string);
var
ts: TSQLTimeStamp;
begin
ts := StrToSQLTimeStamp(AText);
inherited Create;
FDateTime := ts;
end;
constructor TSQLTimeStampData.Create(const ASQLTimeStamp: TSQLTimeStamp);
begin
CheckSqlTimeStamp( ASQLTimeStamp );
inherited Create;
move(ASQLTimeStamp, FDateTime, sizeof(TSQLTimeStamp));
end;
constructor TSQLTimeStampData.Create(const ASource: TSQLTimeStampData);
begin
Create(aSource.DateTime);
end;
procedure TSQLTimeStampData.SetDay(const Value: Word);
begin
Assert((Value >= 1) and (Value <= DaysInAMonth(Year, Month)));
FDateTime.Day := Value;
end;
procedure TSQLTimeStampData.SetFractions(const Value: LongWord);
begin
FDateTime.Fractions := Value;
end;
procedure TSQLTimeStampData.SetHour(const Value: Word);
begin
Assert(Value <= 23); // no need to check for > 0 on Word
FDateTime.Hour := Value;
end;
procedure TSQLTimeStampData.SetMinute(const Value: Word);
begin
Assert(Value <= 59); // no need to check for > 0 on Word
FDateTime.Minute := Value;
end;
procedure TSQLTimeStampData.SetMonth(const Value: Word);
begin
Assert((Value >= 1) and (Value <= 12));
FDateTime.Month := Value;
end;
procedure TSQLTimeStampData.SetSecond(const Value: Word);
begin
Assert(Value <= 59); // no need to check for > 0 on Word
FDateTime.Second := Value;
end;
procedure TSQLTimeStampData.SetYear(const Value: SmallInt);
begin
FDateTime.Year := Value;
end;
{ TSQLTimeStampVariantType }
procedure TSQLTimeStampVariantType.Clear(var V: TVarData);
begin
V.VType := varEmpty;
FreeAndNil(TSQLTimeStampVarData(V).VDateTime);
end;
procedure TSQLTimeStampVariantType.Cast(var Dest: TVarData;
const Source: TVarData);
var
LSource, LTemp: TVarData;
begin
VarDataInit(LSource);
try
VarDataCopyNoInd(LSource, Source);
if VarDataIsStr(LSource) then
TSQLTimeStampVarData(Dest).VDateTime := TSQLTimeStampData.Create(VarDataToStr(LSource))
else
begin
VarDataInit(LTemp);
try
VarDataCastTo(LTemp, LSource, varDate);
TSQLTimeStampVarData(Dest).VDateTime := TSQLTimeStampData.Create(LTemp.VDate);
finally
VarDataClear(LTemp);
end;
end;
Dest.VType := VarType;
finally
VarDataClear(LSource);
end;
end;
procedure TSQLTimeStampVariantType.CastTo(var Dest: TVarData;
const Source: TVarData; const AVarType: TVarType);
var
LTemp: TVarData;
begin
if Source.VType = VarType then
case AVarType of
varOleStr:
VarDataFromOleStr(Dest, TSQLTimeStampVarData(Source).VDateTime.AsString);
varString:
VarDataFromStr(Dest, TSQLTimeStampVarData(Source).VDateTime.AsString);
else
VarDataInit(LTemp);
try
LTemp.VType := varDate;
LTemp.VDate := TSQLTimeStampVarData(Source).VDateTime.AsDateTime;
VarDataCastTo(Dest, LTemp, AVarType);
finally
VarDataClear(LTemp);
end;
end
else
inherited;
end;
procedure TSQLTimeStampVariantType.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
begin
if Indirect and VarDataIsByRef(Source) then
VarDataCopyNoInd(Dest, Source)
else
with TSQLTimeStampVarData(Dest) do
begin
VType := VarType;
VDateTime := TSQLTimeStampData.Create(TSQLTimeStampVarData(Source).VDateTime);
end;
end;
function TSQLTimeStampVariantType.GetInstance(const V: TVarData): TObject;
begin
Result := TSQLTimeStampVarData(V).VDateTime;
end;
procedure TSQLTimeStampVariantType.BinaryOp(var Left: TVarData; const Right: TVarData; const Operator: TVarOp);
begin
case Operator of
opAdd:
TSQLTimeStampVarData(Left).VDateTime.DoAdd(TSQLTimeStampVarData(Right).VDateTime);
opSubtract:
TSQLTimeStampVarData(Left).VDateTime.DoSubtract(TSQLTimeStampVarData(Right).VDateTime);
else
RaiseInvalidOp;
end;
end;
procedure TSQLTimeStampVariantType.Compare(const Left, Right: TVarData; var Relationship: TVarCompareResult);
begin
Relationship := TSQLTimeStampVarData(Left).VDateTime.Compare(TSQLTimeStampVarData(Right).VDateTime);
end;
function VarToSQLTimeStamp(const aValue: Variant): TSQLTimeStamp;
begin
if TVarData(aValue).VType in [varNULL, varEMPTY] then
Result := NullSqlTimeStamp
else if (TVarData(aValue).VType = varString) then
Result := TSQLTimeStampData.Create(String(aValue)).FDateTime
else if (TVarData(aValue).VType = varOleStr) then
Result := TSQLTimeStampData.Create(String(aValue)).FDateTime
else if (TVarData(aValue).VType = varDouble) or (TVarData(aValue).VType = varDate) then
Result := DateTimeToSqlTimeStamp(TDateTime(aValue))
else if (TVarData(aValue).VType = SQLTimeStampVariantType.VarType) then
Result := TSQLTimeStampVarData(aValue).VDateTime.DateTime
else
Raise EVariantError.Create(SInvalidVarCast)
end;
function StrToSQLTimeStamp(const S: string): TSQLTimeStamp;
begin
if not TryStrToSqlTimeStamp(S, Result) then
raise EConvertError.Create(SCouldNotParseTimeStamp);
end;
initialization
SQLTimeStampVariantType := TSQLTimeStampVariantType.Create;
finalization
FreeAndNil(SQLTimeStampVariantType);
end.

67
components/flashfiler/sourcelaz/#NotUsedMore/lazvclfuncs.pas Normal file
View File

@ -0,0 +1,67 @@
// doesn't used more!
// ALL CODE TAKEN FROM DELPHI7 - BORLAND CODE !!!!!!
// use for lazarus lclintf.pas
{
}
unit LazVCLFuncs;
{$I ffdefine.inc}
interface
uses
Classes, SysUtils, Windows;
function AllocateHWnd(Method: TWndMethod): HWND;
procedure DeallocateHWnd(Wnd: HWND);
implementation
var
UtilWindowClass: TWndClass = (
style: 0;
lpfnWndProc: @DefWindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'TPUtilWindow');
function AllocateHWnd(Method: TWndMethod): HWND;
var
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
UtilWindowClass.hInstance := HInstance;
{.$IFDEF PIC}
UtilWindowClass.lpfnWndProc := @DefWindowProc;
{.$ENDIF}
ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass);
//beep
if not ClassRegistered or (@TempClass.lpfnWndProc <> @DefWindowProc) then
begin
if ClassRegistered then
Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(UtilWindowClass);
end;
Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
'', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
if Assigned(Method) then
SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;
procedure DeallocateHWnd(Wnd: HWND);
var
Instance: Pointer;
begin
Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
DestroyWindow(Wnd);
if Instance <> @DefWindowProc then FreeObjectInstance(Instance);
end;
end.

125
components/flashfiler/sourcelaz/LazConvertReadMe.txt Normal file
View File

@ -0,0 +1,125 @@
== TurboPower FlashFiler2Lazarus Port========
Ported from: Soner A.
State: Client and Server compiles without error.
Client Engine working
ServerEngine has error.(Use from compiled one from delphi)
Search in Source for "fpc" or "soner" to look changes.
**********
I substitute LazDbCommon.pas with lazcommon.pas!
NO MORE BORLAND CODE, It uses now TExprParser from fssql.
USED UNITS WITH BORLAND CODE:
LazDbCommon.pas for TExprParser used by ffdb.pas
LazDbComSqlTimSt.pas used only by LazDbCommon.pas (original name from Delphi is: SqlTimSt.pas)
NEW_24.04.2016 you can compile now without delphi unit. It was used only in one "useless" function!
Define in ffdefine.inc:
{$DEFINE DONTUSEDELPHIUNIT} //Disables in ffdb.pas the function TffDataSet.dsCreateLookupFilter
//if it called then it raises exception!
***********
== TODO ====
1. It must be tested more. I am new to FlashFiler. I did not used it until yesterday.
2. Some component, property editors and experts for formular desgin must be ported.
3. You should convert pred(variable) to variable-1 because of pred(word=0) error!
they used it excessive (1144x!)
== Substituted classes ========
This classes/types/procedures aren't exist in Lazarus/Freepascal, I changed them:
unit Original from ff2 New for Lazarus-port
-------- ---------------- --------------------
ffclcoln IDesigner TIDesigner;
IDesignerSelections TComponent; //IDesignerSelections dont exist on laz
TDesignerSelections TComponent;
FDesigner.SetSelections(SelList); FDesigner.SelectOnlyThisComponent(SelList); //soner es gibt ken setselections
for others search for fpc in sourcelaz-folder.
== BUGS/ISSUES ========
FIRST: I ported very fast, the "real" code for db is good ported but i had problems
with the compents editors and experts because i don't know anything about that for lazarus.
1.[SOLVED, I USED IT FALSE]
it works but still error on start of programm, am I using it false? Why working Delphi examples with lazarus seamless and mine don't?]
MAY BE WRONG, test it again, i can play with original example in lazarus without problems
2.[SOLVED, I USED IT FALSE]
Design Editor: If you put TffDataBase and set Property DatabaseName to any value i.e. "mydatabase",
than "mydatabase" should be local alias and it should be shown at TffTable.DatabaseName. But it doesn't.
I think the problem can be:
in ffdb.pas
-FieldDefList, FieldDefList.IndexOf(FullName); //class, function
or in designeditors ffclreg, ffclreng..
3. [SOLVED, I USED IT FALSE]
If you make with delphi example app (like in examples order) and import it to lazarus than it works, but if you make it with lazarus then it doesnot work.
4. [SOLVED -> all definied in ffclreg.dcr, delphi support images from base class but lazarus didn't:
TffLegacyTransport is in ffclreg.dcr as baseclass: TFFBASETRANSPORT]
I could not found some components images for the component palette:
TffServerEngine
TffServerCommandHandler
TffLegacyTransport
TffEventlog
(all other has it in ffclreg.dcr)
5. [SOLVED] fpc makes pred(word=0) = 0 but delphi -1. (Look at ffdb.pas TffBaseTable.dsGetIndexInfo;)
6. [SOLVED]
You must set TffTable.IndexName to Valid else Lazarus will freeze!
An don't set TffTable.IndexName to "Sequential Access Index", Lazarus will be crash!
I appears also on runtime of application
7. In fpc doesn't exists TWriter.Flushbuffer, so I made in ffclreng.pas hackclass TBinaryObjectWriterHack
8.
EmbeddedSErver (TffServerEngine) don't works, because in fpc-classes TReader.ReadString can't read some string-types.
Unicode failure? Look examples\LazEmbeddedServer
== Fast notices during converting/porting to lazarus ========
0. -------------------------
I replaced ffdb.ReSizePersistentFields; FieldDefList with Fielddefs because fpc doesn't has FieldDefList
1. -------------------------
ffclcoln.pas ist parameter editor. i removed this from package because it is not converted to laz and removed from uses of ffclreg,
SelectComponentList()
//IDesignerSelections dont exist on laz
FDesigner.SetSelections(SelList); dont exist on laz
2. -------------------------
These Component editors or experts aren't converted and aren't used in lpk.
ffclver.pas -version.property editor useles for programm dont converted
ffclexpt.pas -FlashFiler: TFFEngineManager Expert
3. -------------------------
ffclreg.pas
Some Property editors and conditions (see below) disabled.
procedure TffServerEngineProperty.GetValueList(List: TStrings);
...
if (Cmpnt is TffBaseServerEngine) and
{$ifndef fpc} Designer.IsComponentLinkable(Cmpnt) and {$endif} //Soner don't exits on lazarus
{$ifndef fpc} //soner ParamEditor not converted
{ TffCollectionProperty }
{register the experts}
{$ifndef fpc} //Soner: I don't know how to do with lazarus
RegisterCustomModule(TffBaseEngineManager, TCustomModule);
RegisterLibraryExpert(TffEngineManagerWizard.Create);
{$endif}
{$ifndef fpc} //don't converted
{$endif}
4. -------------------------
added some code from delphi look: lazsqltimst.pas, lazdbcommon.pas, (lazvclfuncs.pas, lazdbconsts.pas)
5. -------------------------
Flashfiler typen
fftWideChar
fftWideString

46
components/flashfiler/sourcelaz/Rebuild210/FFRebuild210.dpr Normal file
View File

@ -0,0 +1,46 @@
{*********************************************************}
{* Project source file *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
program FFRebuild210;
uses
Forms,
umain in 'umain.pas' {frmMain},
uConfig in 'uConfig.pas',
dmMain in 'dmMain.pas' {dmRebuild: TDataModule};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.

BIN
components/flashfiler/sourcelaz/Rebuild210/FFRebuild210.res Normal file
View File

Binary file not shown.

BIN
components/flashfiler/sourcelaz/Rebuild210/dmMain.dfm Normal file
View File

Binary file not shown.

144
components/flashfiler/sourcelaz/Rebuild210/dmMain.pas Normal file
View File

@ -0,0 +1,144 @@
{*********************************************************}
{* FlashFiler: Data module for FFRebuild210 *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit dmMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ffdb, ffdbbase, ffllbase, ffllcomp, fflleng, ffsrintm, ffsreng;
type
TdmRebuild = class(TDataModule)
ServerEngine: TffServerEngine;
Client: TffClient;
Session: TffSession;
DB: TffDatabase;
private
{ Private declarations }
function GetActive : Boolean;
function GetDatabase : TffDatabase;
function GetPath : string;
function GetServerDatabase : TffSrDatabase;
procedure SetActive(const Value : Boolean);
procedure SetPath(const Value : string);
public
{ Public declarations }
procedure GetTables(TableList : TStringList);
{ Returns a string list containing one entry per table in the
database path. The string portion contains the name of the table.
The object portion contains an inactive TffTable tied to the
session, database, and table names. }
property Active : Boolean
read GetActive
write SetActive;
property Database : TffDatabase
read GetDatabase;
property Path : string
read GetPath
write SetPath;
property ServerDatabase : TffSrDatabase
read GetServerDatabase;
end;
var
dmRebuild: TdmRebuild;
implementation
{$R *.DFM}
{====================================================================}
function TdmRebuild.GetActive : Boolean;
begin
Result := DB.Connected;
end;
{--------}
function TdmRebuild.GetDatabase : TffDatabase;
begin
Result := DB;
end;
{--------}
function TdmRebuild.GetPath : string;
begin
Result := DB.AliasName;
end;
{--------}
function TdmRebuild.GetServerDatabase : TffSrDatabase;
begin
Result := TffSrDatabase(dmRebuild.Database.DatabaseID);
end;
{--------}
procedure TdmRebuild.GetTables(TableList : TStringList);
var
Inx : Integer;
Table : TffTable;
begin
if DB.AliasName = '' then
ShowMessage('Source directory not specified')
else begin
DB.Connected := True;
TableList.Clear;
DB.GetTableNames(TableList);
for Inx := 0 to Pred(TableList.Count) do begin
Table := TffTable.Create(nil);
with Table do begin
SessionName := Self.Session.SessionName;
DatabaseName := DB.DatabaseName;
TableName := TableList[Inx];
TableList.Objects[Inx] := Table;
end;
end; { for }
end;
end;
{--------}
procedure TdmRebuild.SetActive(const Value : Boolean);
begin
DB.Connected := Value;
end;
{--------}
procedure TdmRebuild.SetPath(const Value : string);
begin
if Value <> DB.AliasName then begin
DB.Connected := False;
DB.AliasName := Value;
end;
end;
{====================================================================}
end.

5
components/flashfiler/sourcelaz/Rebuild210/ffrebuild210.ini Normal file
View File

@ -0,0 +1,5 @@
[Config]
AutoRun=0
AllowChangeDirectory=1
InitialDirectory=c:\

60
components/flashfiler/sourcelaz/Rebuild210/ffrebuild210.rc Normal file
View File

@ -0,0 +1,60 @@
/*********************************************************
* Main program icon resource *
*********************************************************/
/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */
#define VERSIONINFO_1 1
VERSIONINFO_1 VERSIONINFO
FILEVERSION 2, 1, 3, 0
PRODUCTVERSION 2, 1, 3, 0
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
{
BLOCK "StringFileInfo"
{
BLOCK "040904E4"
{
VALUE "CompanyName", "TurboPower Software Company\000\000"
VALUE "FileDescription", "FlashFiler FFRebuild Utility\000"
VALUE "FileVersion", "2.1.3.0\000"
VALUE "InternalName", "FFREBUILD210\000"
VALUE "LegalCopyright", "Copyright (c) TurboPower Software Co. 1996-2002\000\000"
VALUE "OriginalFilename", "FFREBUILD210.EXE\000"
VALUE "ProductName", "FlashFiler (Delphi Edition)\000"
VALUE "ProductVersion", "2.1.3.0\000"
}
}
BLOCK "VarFileInfo"
{
VALUE "Translation", 0x409, 1252
}
}

184
components/flashfiler/sourcelaz/Rebuild210/uConfig.pas Normal file
View File

@ -0,0 +1,184 @@
{*********************************************************}
{* FlashFiler: Config interface for FFRebuild210 *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit uConfig;
interface
uses
IniFiles;
type
TFallbackConfig = class
protected
FIni : TINIFile;
procedure IniCreate;
procedure IniFree;
function GetAllowChangeDir : Boolean;
function GetAutoRun : Boolean;
function GetInitialDir : string;
function GetOutputDir : string;
procedure SetAllowChangeDir(const Value : Boolean);
procedure SetAutoRun(const Value : Boolean);
procedure SetInitialDir(const Value : string);
procedure SetOutputDir(const Value : string);
public
property AllowChangeDir : Boolean
read GetAllowChangeDir
write SetAllowChangeDir;
property AutoRun : Boolean
read GetAutoRun
write SetAutoRun;
property InitialDir : string
read GetInitialDir
write SetInitialDir;
property OutputDir : string
read GetOutputDir
write SetOutputDir;
end;
implementation
uses
Forms,
SysUtils;
const
csAllowChangeDir = 'AllowChangeDirectory';
csAutoRun = 'AutoRun';
csIniName = 'FFRebuild210.ini';
csInitialDir = 'InitialDirectory';
csOutputDir = 'OutputDirectory';
csSection = 'Config';
{====================================================================}
function TFallbackConfig.GetAllowChangeDir : Boolean;
begin
IniCreate;
try
Result := FIni.ReadBool(csSection, csAllowChangeDir, False);
finally
IniFree;
end;
end;
{--------}
function TFallbackConfig.GetAutoRun : Boolean;
begin
IniCreate;
try
Result := FIni.ReadBool(csSection, csAutoRun, False);
finally
IniFree;
end;
end;
{--------}
function TFallbackConfig.GetInitialDir : string;
begin
IniCreate;
try
Result := FIni.ReadString(csSection, csInitialDir, '');
finally
IniFree;
end;
end;
{--------}
function TFallbackConfig.GetOutputDir : string;
begin
IniCreate;
try
Result := FIni.ReadString(csSection, csOutputDir, '');
finally
IniFree;
end;
end;
{--------}
procedure TFallbackConfig.IniCreate;
begin
FIni := TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
end;
{--------}
procedure TFallbackConfig.IniFree;
begin
FIni.Free;
end;
{--------}
procedure TFallbackConfig.SetAllowChangeDir(const Value : Boolean);
begin
IniCreate;
try
FIni.WriteBool(csSection, csAllowChangeDir, Value);
finally
IniFree;
end;
end;
{--------}
procedure TFallbackConfig.SetAutoRun(const Value : Boolean);
begin
IniCreate;
try
FIni.WriteBool(csSection, csAutoRun, Value);
finally
IniFree;
end;
end;
{--------}
procedure TFallbackConfig.SetInitialDir(const Value : string);
begin
IniCreate;
try
FIni.WriteString(csSection, csInitialDir, Value);
finally
IniFree;
end;
end;
{--------}
procedure TFallbackConfig.SetOutputDir(const Value : string);
begin
IniCreate;
try
FIni.WriteString(csSection, csOutputDir, Value);
finally
IniFree;
end;
end;
{====================================================================}
end.

BIN
components/flashfiler/sourcelaz/Rebuild210/umain.dfm Normal file
View File

Binary file not shown.

291
components/flashfiler/sourcelaz/Rebuild210/umain.pas Normal file
View File

@ -0,0 +1,291 @@
{*********************************************************}
{* FlashFiler: Main form for FFRebuild210 *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit umain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls;
type
TRebuildState = (stIdle, stRunning);
TfrmMain = class(TForm)
pnlTop: TPanel;
lvTables: TListView;
pnlBottom: TPanel;
prgCurrentFile: TProgressBar;
prgAllFiles: TProgressBar;
lblPrgFile: TLabel;
lblPrgAllFiles: TLabel;
lblInitialDir: TLabel;
efInitialDir: TEdit;
pbRebuild: TButton;
pbClose: TButton;
procedure FormShow(Sender: TObject);
procedure pbCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure pbRebuildClick(Sender: TObject);
procedure efInitialDirChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
{ Configuration items }
FAllowChangeDir : Boolean;
FAutoRun : Boolean;
FInitialDir : string;
FOutputDir : string;
{ Status variables }
FFirstTime : Boolean;
FState : TRebuildState;
FValidConfig : Boolean;
procedure ClearTables;
procedure GetTables;
procedure SetCtrlStates;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses
FileCtrl,
ffDB,
ffllBase,
ffclreng,
ffSrEng,
uConfig, dmMain;
{$R *.DFM}
const
csIdle = '...';
csRebuilding = 'Rebuilding...';
csRebuilt = 'Rebuilt successfully';
procedure TfrmMain.FormShow(Sender: TObject);
var
Config : TFallBackConfig;
begin
FFirstTime := True;
FState := stIdle;
FValidConfig := True;
lblPrgFile.Caption := '';
lblPrgAllFiles.Caption := '';
dmRebuild := TdmRebuild.Create(nil);
Config := TFallBackConfig.Create;
try
FAllowChangeDir := Config.AllowChangeDir;
FAutoRun := Config.AutoRun;
FInitialDir := Config.InitialDir;
FOutputDir := Config.OutputDir;
{ Check requirements }
if (FAutoRun or
(not FAllowChangeDir)) and
(FInitialDir = '') then begin
FValidConfig := False;
ShowMessage('Initial directory must be specified in configuration file.');
end;
if (FInitialDir <> '') and
(not DirectoryExists(FInitialDir)) then begin
FValidConfig := False;
ShowMessage('Directory ' + FInitialDir + ' does not exist.');
end;
efInitialDir.Text := FInitialDir;
{ This line forces the list of tables to be loaded. }
finally
Config.Free;
end;
end;
procedure TfrmMain.pbCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.SetCtrlStates;
var
Running : Boolean;
begin
Running := (FState = stRunning);
efInitialDir.Enabled := FValidConfig and FAllowChangeDir and (not Running);
pbRebuild.Enabled := FValidConfig and (not Running) and DirectoryExists(efInitialDir.Text);
pbClose.Enabled := not Running;
end;
procedure TfrmMain.GetTables;
var
Inx : Integer;
Tables : TStringList;
Item : TListItem;
begin
ClearTables;
Tables := TStringList.Create;
try
dmRebuild.Path := efInitialDir.Text;
dmRebuild.GetTables(Tables);
{ Put 1 entry per table into the list view. }
for Inx := 0 to Pred(Tables.Count) do begin
Item := lvTables.Items.Add;
Item.Caption := Tables[Inx];
Item.Data := Tables.Objects[Inx];
Item.SubItems.Add(TffTable(Tables.Objects[Inx]).FFVersion);
Item.SubItems.Add(csIdle);
end;
finally
Tables.Free;
{ We don't have to free the table objects because they are already
attached to the items in list view. }
end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClearTables;
dmRebuild.Free;
end;
procedure TfrmMain.ClearTables;
var
Inx : Integer;
begin
for Inx := Pred(lvTables.Items.Count) downto 0 do
TffTable(lvTables.Items[Inx].Data).Free;
lvTables.Items.Clear;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := (FState = stIdle);
end;
type
SrDBCracker = class(TffSrDatabase);
procedure TfrmMain.pbRebuildClick(Sender: TObject);
var
Done : Boolean;
Count,
Inx : Integer;
Item : TListItem;
ServerDB : TffSrDatabase;
TaskID : Longint;
TaskStatus : TffRebuildStatus;
begin
FState := stRunning;
try
SetCtrlStates;
{ Init progress bars }
prgAllFiles.Max := lvTables.Items.Count;
prgAllFiles.Min := 0;
prgAllFiles.Position := 0;
prgCurrentFile.Min := 0;
prgCurrentFile.Max := 100;
prgCurrentFile.Position := 0;
{ Force pack to open source table as 2_11. }
ServerDB := dmRebuild.ServerDatabase;
SrDBCracker(ServerDB).dbSetPackSrcTableVersion(FFVersionNumber);
{ Assumes current version is > 2_1000. }
{ Force database to create new tables as 2_10. }
SrDBCracker(ServerDB).dbSetNewTableVersion(FFVersion2_10);
Count := lvTables.Items.Count;
for Inx := 0 to Pred(Count) do begin
Item := lvTables.Items[Inx];
Item.SubItems[1] := csRebuilding;
lblPrgFile.Caption := Item.Caption;
lblPrgAllFiles.Caption := Format('%d of %d', [Inx + 1, Count]);
{ Pack the table. }
TffTable(Item.Data).PackTable(TaskID);
{ Wait until the pack is done. }
Done := False;
while not Done do begin
dmRebuild.Session.GetTaskStatus(TaskID, Done, TaskStatus);
{ Update individual file progress bar }
prgCurrentFile.Position := TaskStatus.rsPercentDone;
Sleep(100);
Application.ProcessMessages;
end;
{ Update all files progress bar }
prgAllFiles.Position := prgAllFiles.Position + 1;
Item.SubItems[0] := TffTable(Item.Data).FFVersion;
Item.SubItems[1] := csRebuilt;
end;
lblPrgFile.Caption := '';
lblPrgAllFiles.Caption := '';
finally
FState := stIdle;
SetCtrlStates;
end;
end;
procedure TfrmMain.efInitialDirChange(Sender: TObject);
begin
SetCtrlStates;
if DirectoryExists(efInitialDir.Text) then
GetTables
else
ClearTables;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
SetCtrlStates;
if FValidConfig and FFirstTime and FAutoRun then begin
FFirstTime := False;
pbRebuildClick(nil);
end;
end;
end.

744
components/flashfiler/sourcelaz/Verify/FFChain.pas Normal file
View File

@ -0,0 +1,744 @@
{*********************************************************}
{* FlashFiler: Chain manager *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
{ TODO::
- Implement adding of block
- Implement review of chains
}
unit FFChain;
interface
uses
Classes,
FFLLBase;
type
TffChainMgr = class; { forward declaration }
TffChainItem = class; { forward declaration }
TffRefMode = (rmNext, rmPrev, rmBoth);
TffChain = class
protected
FOwner : TffChainMgr;
public
PrevChain : TffChain;
NextChain : TffChain;
HeadItem : TffChainItem;
TailItem : TffChainItem;
constructor Create(Owner : TffChainMgr);
destructor Destroy; override;
procedure AppendItem(NewItem : TffChainItem);
{ Append the specified item to the chain. }
function FindItem(const ThisBlock : TffWord32) : TffChainItem;
{ Find an item with the given block number. }
function FindItemPointingTo(const ThisBlock : TffWord32;
const Mode : TffRefMode) : TffChainItem;
{ Find an item pointing to the specified block number. }
procedure InsertHead(NewHead : TffChainItem);
{ Insert a new head item into the chain. }
procedure RemoveItem(Item : TffChainItem);
{ Remove the specified item from the chain. }
end;
TffChainItem = class
protected
FOwner : TffChain;
public
NextItem,
PrevItem : TffChainItem;
ThisBlock : TffWord32;
NextBlock : TffWord32;
PrevBlock : TffWord32;
constructor Create(Owner : TffChain);
destructor Destroy; override;
end;
TffLinkCallback = procedure(const Block1Num, Block2Num : TffWord32) of object;
{ Called when two blocks are linked together. }
TffMoveCallback = procedure(const BlockMoved, PrevBlock : TffWord32) of object;
{ Called when an orphan is moved to the end of the chain. }
TffChainMgr = class
protected
FPopulated : Boolean;
OrphanChain : TffChain;
HeadChain : TffChain;
TailChain : TffChain;
procedure AppendChain(NewChain : TffChain);
function GetHasOrphans : Boolean;
function GetHasValidChain : Boolean;
function GetLastBlockNumber : TffWord32;
function GetLastNextBlockNumber : TffWord32;
procedure RemoveReference(const BlockNum : TffWord32;
Item : TffChainItem;
const AdjustChain : Boolean);
public
constructor Create;
destructor Destroy; override;
procedure AddBlock(const ThisBlock, NextBlock, PrevBlock : TffWord32);
procedure Clear;
{ Removes the current chains from the chain manager. }
function Describe : TStringList;
{ Returns a string list describing the chains. }
function FindItem(const BlockNum : TffWord32;
var PrevBlock, NextBlock : TffWord32) : Boolean;
{ Use this method to determine if a block is listed in the chain manager.
If it is not listed, this function returns False. Otherwise, this
function returns True. It fills PrevBlock with the block number of
the previous block in the chain (or ffc_W32NoValue if there is no
previous block) and fills NextBlock with the block number of the next
block (or ffc_W32NoValue for no next block). }
procedure Fixup;
{ If there is only 1 block in the orphan chain & no blocks in other chains
then we have the case where there is only 1 free block or 1 data block
in the table. Move the orphan to its own chain. }
procedure LinkChains(CallBack : TffLinkCallback);
{ Use this method to have the chain manager link together all of its
chains. Does not affect the orphan chain. }
procedure MoveOrphansToTail(Callback : TffMoveCallBack);
{ Use this method to have the chain manager append all of the orphans
in the orphan chain to the last chain. }
function Referenced(const BlockNum : TffWord32;
const RemoveRef : Boolean;
var ReferencingBlockNum : TffWord32) : Boolean;
{ Returns True if the specified BlockNum is referenced as a Prev or Next
block in the chain manager. If it is referenced then this function
returns True and places the block number of the referencing block in
the ReferencingBlockNum param. If the RemoveRef parameter is set to True
then the reference to the block number in the chain manager is set to
the value ffc_W32NoValue. }
property HasOrphans : Boolean
read GetHasOrphans;
property HasValidChain : Boolean
read GetHasValidChain;
property LastBlockNumber : TffWord32
read GetLastBlockNumber;
{ Returns the block number of the last block. }
property LastBlockNextBlockNumber : TffWord32
read GetLastNextBlockNumber;
{ Returns the next block number of the last block in the chain. }
property Populated : Boolean
read FPopulated write FPopulated;
{ Returns True if the chain manager has been fully populated with data. }
end;
implementation
uses
SysUtils;
{===TffChainMgr======================================================}
constructor TffChainMgr.Create;
begin
inherited;
FPopulated := False;
end;
{--------}
destructor TffChainMgr.Destroy;
begin
Clear;
inherited;
end;
{--------}
procedure TffChainMgr.AddBlock(const ThisBlock, NextBlock, PrevBlock : TffWord32);
var
Item,
OrphanItem : TffChainItem;
Chain,
NewChain : TffChain;
begin
{ Create an item for the block. }
Item := TffChainItem.Create(nil);
Item.ThisBlock := ThisBlock;
Item.NextBlock := NextBlock;
Item.PrevBlock := PrevBlock;
{ Step 1: Does this block point to an orphan? If so then grab the orphan.
We may be able to move the new block and the orphan to an existing chain
or at least start a new chain.}
OrphanItem := nil;
if OrphanChain <> nil then begin
OrphanItem := OrphanChain.FindItem(NextBlock);
{ If found an orphan then remove it from the orphan chain. }
if Assigned(OrphanItem) then
OrphanChain.RemoveItem(OrphanItem);
end; { if }
{ Step 2: If this block didn't point to an orphan, see if an orphan points
to this block. }
if (OrphanItem = nil) and (OrphanChain <> nil) then begin
OrphanItem := OrphanChain.FindItemPointingTo(ThisBlock, rmNext);
if Assigned(OrphanItem) then begin
{ Remove the orphan from the orphan chain. }
OrphanChain.RemoveItem(OrphanItem);
{ Start a new chain. }
NewChain := TffChain.Create(Self);
AppendChain(NewChain);
{ Add the orphan to the new chain. }
NewChain.AppendItem(OrphanItem);
{ Add the new chain item to the new chain. }
NewChain.AppendItem(Item);
Exit;
end; { if }
end; { if }
{ Step 3 : If the block does not point to an orphan, does it point to the
head of an existing chain? If so then add it to the beginning of that
chain. }
if OrphanItem = nil then begin
Chain := HeadChain;
while Assigned(Chain) and (Chain.HeadItem.ThisBlock <> NextBlock) do
Chain := Chain.NextChain;
if Assigned(Chain) then begin
Chain.InsertHead(Item);
Exit;
end; { if }
end;
{ Step 4 : If the block does not point to a head of an existing chain, does
the tail of an existing chain point to the block? If so then add it to the
end of that chain. Bring along an orphan if one was pulled in Step 1. }
Chain := HeadChain;
while Assigned(Chain) and (Chain.TailItem.NextBlock <> ThisBlock) do
Chain := Chain.NextChain;
if Assigned(Chain) then begin
Chain.AppendItem(Item);
if Assigned(OrphanItem) then
Chain.AppendItem(OrphanItem);
end
else begin
{ There are no chains where a tail points to this block. If found an
associated orphan in Step 1 then start a new chain. Otherwise, add this
block to the list of orphans. }
if Assigned(OrphanItem) then begin
{ Start a new chain. }
NewChain := TffChain.Create(Self);
AppendChain(NewChain);
{ Add the new chain item to the new chain. }
NewChain.AppendItem(Item);
{ Add the orphan to the new chain. }
NewChain.AppendItem(OrphanItem);
end
else begin
if OrphanChain = nil then
OrphanChain := TffChain.Create(Self);
OrphanChain.AppendItem(Item);
end; { if..else }
end;
end;
{--------}
procedure TffChainMgr.AppendChain(NewChain : TffChain);
begin
if TailChain = nil then begin
HeadChain := NewChain;
TailChain := HeadChain;
end
else begin
{ Point the last chain to the new chain, and vice versa. }
TailChain.NextChain := NewChain;
NewChain.PrevChain := TailChain;
TailChain := NewChain;
end;
end;
{--------}
procedure TffChainMgr.Clear;
var
Chain,
NextChain : TffChain;
begin
OrphanChain.Free;
OrphanChain := nil;
Chain := HeadChain;
while Chain <> nil do begin
NextChain := Chain.NextChain;
Chain.Free;
Chain := NextChain;
end; { while }
HeadChain := nil;
TailChain := nil;
end;
{--------}
function TffChainMgr.Describe : TStringList;
var
Chain : TffChain;
Item : TffChainItem;
Inx,
Count : Integer;
begin
Result := TStringList.Create;
try
{ Orphaned blocks }
if (OrphanChain <> nil) and (OrphanChain.HeadItem <> nil) then begin
Result.Add('Orphaned blocks:');
Item := OrphanChain.HeadItem;
while Item <> nil do begin
Result.Add(Format('Block: %d, next block: %d, prev block: %d',
[Item.ThisBlock, Item.NextBlock, Item.PrevBlock]));
Item := Item.NextItem;
end; { while }
end
else
Result.Add('No orphaned blocks');
{ Other blocks. First, count the number of chains. }
Count := 0;
Chain := HeadChain;
while Chain <> nil do begin
inc(Count);
Chain := Chain.NextChain;
end; { while }
{ Now step through the chains. }
Result.Add('');
if Count = 0 then
Result.Add('No chains')
else begin
Chain := HeadChain;
Inx := 0;
while Chain <> nil do begin
inc(Inx);
Result.Add(Format('Chain %d of %d', [Inx, Count]));
{ Display information about the first block & the last block in the
chain. }
Item := Chain.HeadItem;
if (Item <> nil) then begin
if (Chain.HeadItem = Chain.TailItem) then begin
Result.Add(Format('There is 1 block in this chain, block: %d, ' +
'next block: %d, prev Block: %d',
[Item.ThisBlock, Item.NextBlock, Item.PrevBlock]));
end
else begin
Result.Add(Format('Head, block: %d, next block: %d, prev block: %d',
[Item.ThisBlock, Item.NextBlock, Item.PrevBlock]));
Item := Chain.TailItem;
Result.Add(Format('Tail, block: %d, next block: %d, prev block: %d',
[Item.ThisBlock, Item.NextBlock, Item.PrevBlock]));
end;
end; { if }
Chain := Chain.NextChain;
end; { while }
end;
except
Result.Free;
raise;
end;
end;
{--------}
function TffChainMgr.FindItem(const BlockNum : TffWord32;
var PrevBlock, NextBlock : TffWord32) : Boolean;
var
Item : TffChainItem;
Chain : TffChain;
begin
Result := False;
PrevBlock := ffc_W32NoValue;
NextBlock := ffc_W32NoValue;
{ Look in the orphans first. }
Item := OrphanChain.FindItem(BlockNum);
if Item = nil then begin
{ Not an orphan. Look in the other chains. }
Chain := HeadChain;
while (Chain <> nil) do begin
Item := Chain.FindItem(BlockNum);
if Item <> nil then begin
Result := True;
PrevBlock := Item.PrevBlock;
NextBlock := Item.NextBlock;
Break;
end; { if }
Chain := Chain.NextChain;
end;
end
else
Result := True;
end;
{--------}
procedure TffChainMgr.Fixup;
var
Item : TffChainItem;
Chain : TffChain;
begin
{ If the orphan chain contains only 1 block & there are no other chains
being managed then we have a valid chain with one block. Move the block
from the orphan chain to a new chain. }
if Assigned(OrphanChain) and
Assigned(OrphanChain.HeadItem) and
(OrphanChain.HeadItem = OrphanChain.TailItem) and
(HeadChain = nil) then begin
Item := OrphanChain.HeadItem;
OrphanChain.RemoveItem(Item);
Chain := TffChain.Create(Self);
AppendChain(Chain);
Chain.AppendItem(Item);
end; { if }
end;
{--------}
function TffChainMgr.GetHasOrphans : Boolean;
begin
Result := (OrphanChain <> nil) and (OrphanChain.HeadItem <> nil);
end;
{--------}
function TffChainMgr.GetHasValidChain : Boolean;
begin
{ The chain is valid if the following conditions are met:
There are no orphans
- AND either of the following -
1. There are no data blocks
- OR -
2. There is only 1 chain in the chain manager.
}
Result := (not GetHasOrphans) and
(
(HeadChain = nil) or
((HeadChain.HeadItem <> nil) and
(HeadChain = TailChain)
)
);
end;
{--------}
function TffChainMgr.GetLastBlockNumber : TffWord32;
begin
if Assigned(TailChain) and
Assigned(TailChain.TailItem) then
Result := TailChain.TailItem.ThisBlock
else
Result := ffc_W32NoValue;
end;
{--------}
function TffChainMgr.GetLastNextBlockNumber : TffWord32;
begin
if Assigned(TailChain) and
Assigned(TailChain.TailItem) then
Result := TailChain.TailItem.NextBlock
else
Result := ffc_W32NoValue;
end;
{--------}
function TffChainMgr.Referenced(const BlockNum : TffWord32;
const RemoveRef : Boolean;
var ReferencingBlockNum : TffWord32) : Boolean;
var
Item : TffChainItem;
Chain : TffChain;
begin
Result := False;
ReferencingBlockNum := ffc_W32NoValue;
{ Search the orphan chain. }
if OrphanChain <> nil then begin
Item := OrphanChain.FindItemPointingTo(BlockNum, rmBoth);
if Item <> nil then begin
Result := True;
ReferencingBlockNum := Item.ThisBlock;
if RemoveRef then
RemoveReference(BlockNum, Item, False);
end; { if }
end; { if }
if not Result then begin
Chain := HeadChain;
while Chain <> nil do begin
Item := Chain.FindItemPointingTo(BlockNum, rmBoth);
if Item <> nil then begin
Result := True;
ReferencingBlockNum := Item.ThisBlock;
if RemoveRef then
RemoveReference(BlockNum, Item, True);
Break;
end
else
Chain := Chain.NextChain;
end; { while }
end; { if..else }
end;
{--------}
procedure TffChainMgr.LinkChains(CallBack : TffLinkCallback);
var
NextChain,
Chain : TffChain;
Block1Num,
Block2Num : TffWord32;
begin
if HeadChain <> nil then begin
Chain := HeadChain.NextChain;
while Chain <> nil do begin
NextChain := Chain.NextChain;
Block1Num := HeadChain.TailItem.ThisBlock;
Block2Num := Chain.HeadItem.ThisBlock;
{ Connect the last item in the head chain to the first item in the current
chain. }
HeadChain.TailItem.NextItem := Chain.HeadItem;
HeadChain.TailItem.NextBlock := Chain.HeadItem.ThisBlock;
{ Point the first item in the current chain back to the head chain's tail
item. }
Chain.HeadItem.PrevItem := HeadChain.TailItem;
Chain.HeadItem.PrevBlock := HeadChain.TailItem.ThisBlock;
{ Update the head chain's tail item. }
HeadChain.TailItem := Chain.TailItem;
if Assigned(CallBack) then
CallBack(Block1Num, Block2Num);
{ Remove all associations the current chain has with its items. }
Chain.HeadItem := nil;
Chain.TailItem := nil;
{ Free the chain. }
Chain.Free;
{ Move to the next chain. }
Chain := NextChain;
end;
{ There should be no more chains after the head chain. }
HeadChain.NextChain := nil;
TailChain := HeadChain;
end; { if }
end;
{--------}
procedure TffChainMgr.MoveOrphansToTail(Callback : TffMoveCallBack);
var
BlockNum, PrevBlock : TffWord32;
NextItem,
Item : TffChainItem;
begin
Item := OrphanChain.TailItem;
while Item <> nil do begin
NextItem := Item.NextItem;
BlockNum := Item.ThisBlock;
PrevBlock := TailChain.TailItem.ThisBlock;
OrphanChain.RemoveItem(Item);
TailChain.AppendItem(Item);
if Assigned(Callback) then
Callback(BlockNum, PrevBlock);
Item := NextItem;
end; { while }
end;
{--------}
procedure TffChainMgr.RemoveReference(const BlockNum : TffWord32;
Item : TffChainItem;
const AdjustChain : Boolean);
begin
if Item.PrevBlock = BlockNum then begin
if AdjustChain and (Item.PrevItem <> nil) then begin
Assert(false, 'Unhandled case. Please report to FlashFiler team.');
end;
Item.PrevBlock := ffc_W32NoValue;
end
else begin
if AdjustChain and (Item.NextItem <> nil) then begin
Assert(false, 'Unhandled case. Please report to FlashFiler team.');
end;
Item.NextBlock := ffc_W32NoValue;
end;
end;
{====================================================================}
{===TffChain=========================================================}
constructor TffChain.Create(Owner : TffChainMgr);
begin
inherited Create;
FOwner := Owner;
end;
{--------}
destructor TffChain.Destroy;
var
Item,
NextItem : TffChainItem;
begin
inherited;
Item := HeadItem;
while Item <> nil do begin
NextItem := Item.NextItem;
Item.Free;
Item := NextItem;
end; { while }
end;
{--------}
procedure TffChain.AppendItem(NewItem : TffChainItem);
begin
{ If no tail then this chain is empty. }
if TailItem = nil then begin
HeadItem := NewItem;
TailItem := NewItem;
end
else begin
{ Otherwise, append the item to the tail. }
TailItem.NextItem := NewItem;
NewItem.PrevItem := TailItem;
TailItem := NewItem;
end;
NewItem.FOwner := Self;
end;
{--------}
function TffChain.FindItem(const ThisBlock : TffWord32) : TffChainItem;
begin
Result := HeadItem;
while (Result <> nil) and (Result.ThisBlock <> ThisBlock) do
Result := Result.NextItem;
end;
{--------}
function TffChain.FindItemPointingTo(const ThisBlock : TffWord32;
const Mode : TffRefMode) : TffChainItem;
begin
Result := HeadItem;
case Mode of
rmNext :
while (Result <> nil) and (Result.NextBlock <> ThisBlock) do
Result := Result.NextItem;
rmPrev :
while (Result <> nil) and (Result.PrevBlock <> ThisBlock) do
Result := Result.NextItem;
rmBoth :
while (Result <> nil) and (Result.NextBlock <> ThisBlock) and
(Result.PrevBlock <> ThisBlock) do
Result := Result.NextItem;
end; { case }
end;
{--------}
procedure TffChain.InsertHead(NewHead : TffChainItem);
begin
if HeadItem = nil then begin
HeadItem := NewHead;
TailItem := NewHead;
end
else begin
{ Point the head to the new head, and vice versa. }
HeadItem.PrevItem := NewHead;
NewHead.NextItem := HeadItem;
HeadItem := NewHead;
end;
end;
{--------}
procedure TffChain.RemoveItem(Item : TffChainItem);
var
CurItem : TffChainItem;
begin
{ If this is the head item then the next item is the new head. }
if Item = HeadItem then begin
HeadItem := Item.NextItem;
{ If there is a new head then set its prevItem to nil. }
if Assigned(HeadItem) then
HeadItem.PrevItem := nil
else
{ Otherwise the chain is empty so set the tail to nil. }
TailItem := nil;
end
{ If this is not the head but it is the tail then the previous item is the
new tail. }
else if Item = TailItem then begin
TailItem := Item.PrevItem;
{ If there is a new tail then set its NextItem to nil. }
if Assigned(TailItem) then
TailItem.NextItem := nil
else
{ Otherwise the chain is empty so set the head to nil. }
HeadItem := nil;
end
else begin
{ This item is somewhere between the head & tail. Scan for it. }
CurItem := HeadItem;
while CurItem <> Item do
CurItem := CurItem.NextItem;
if Assigned(CurItem) then begin
{ Point the previous item to the next item. }
CurItem.PrevItem.NextItem := CurItem.NextItem;
{ Point the next item to the previous item. }
CurItem.NextItem.PrevItem := CurItem.PrevItem;
end; { if }
end;
{ Nil out the item's pointers. }
Item.NextItem := nil;
Item.PrevItem := nil;
Item.FOwner := nil;
end;
{====================================================================}
{===TffChainItem=====================================================}
constructor TffChainItem.Create(Owner : TffChain);
begin
inherited Create;
FOwner := Owner;
end;
{--------}
destructor TffChainItem.Destroy;
begin
inherited;
{ TODO }
end;
{====================================================================}
end.

47
components/flashfiler/sourcelaz/Verify/FFVerify.dpr Normal file
View File

@ -0,0 +1,47 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
program FFVerify;
uses
Forms,
frMain in 'frMain.pas' {frmMain},
ffrepair in 'ffrepair.pas',
ffv2file in 'ffv2file.pas',
ffFileInt in 'ffFileInt.pas',
ffrepcnst in 'ffrepcnst.pas',
frmBlock in 'frmBlock.pas' {frmBlockNum},
FFChain in 'FFChain.pas',
frmOptions in 'frmOptions.pas' {frmOptionsConfig};
{$R *.res}
begin
Application.Initialize;
Application.Title := 'FlashFiler Table Repair';
Application.CreateForm(TfrmMain, frmMain);
Application.CreateForm(TfrmOptionsConfig, frmOptionsConfig);
Application.Run;
end.

BIN
components/flashfiler/sourcelaz/Verify/FFVerify.res Normal file
View File

Binary file not shown.

1527
components/flashfiler/sourcelaz/Verify/ffFileInt.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1065
components/flashfiler/sourcelaz/Verify/ffrepair.pas Normal file
View File

File diff suppressed because it is too large Load Diff

257
components/flashfiler/sourcelaz/Verify/ffrepcnst.pas Normal file
View File

@ -0,0 +1,257 @@
{*********************************************************}
{* FlashFiler: FF 2 file repair constants *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit ffrepcnst;
interface
type
TffRepairAction = (raDecide, raSelfRepair, raPack, raUnsalvageable);
{ This enumerated type represents the different types of repair actions
that may be taken. Values:
raDecide - The parent repair logic must decide what action to take based
upon the current context. For example, if the data dictionary block
reported that it had an unknown block type then the repair logic could
decide the table is unsalvageable. But if it were an index or data
block that did not know its block type then the repair logic could
decide the table needed to be reindexed or restructured.
raSelfRepair - Allow the block to repair itself.
raPack - Restructure the table.
raUnsalvageable - The data is so badly damaged that nothing can be
done with the table.
}
const
{ Verify error codes. }
rciUnknownBlockType = 1;
rciInvalidBlockRefNext = 2;
rciInvalidBlockRefDict = 3;
rciInvalidThisBlock = 4;
rciInvalidBlockSize = 5;
rciNoDictBlock = 6;
rciInvalidInt64 = 7;
rciNoDataBlockForRecs = 8;
rciInvalidBlockRefFirstData = 9;
rciInvalidBlockRefFirstFree = 10;
rciInvalidSeqIndexFlag = 11;
rciInvalidBlockRefIndexHead = 12;
rciNoLastDataBlockForRecs = 13;
rciInvalidBlockRefLastData = 14;
rciInvalidLog2BlockSize = 15;
rciInvalidUsedBlocks = 16;
rciInxHeaderInvalidRowCount = 17;
rciInxHeaderInvalidKeyLen = 18;
rciInxHeaderInvalidKeyCount = 19;
rciInxHeaderNoRootPage = 20;
rciInxHeaderInvalidRootPage = 21;
rciInxHeaderNoRefsFlag = 22;
rciInxHeaderNoDupsFlag = 23;
rciInvalidInxPrefPageRef = 24;
rciInxInvalidBlockRef = 25;
rciInvalidLeafKeyBlockRef = 26;
rciInvalidLeafKeyRefNum = 27;
rciInvalidIntrnalKeyBlockRef = 28;
rciInvalidIntrnalKeyRefNum = 29;
rciInvalidDataBlockRecCount = 30;
rciInvalidDataBlockRecLen = 31;
rciInvalidNextDataBlock = 32;
rciInvalidPrevDataBlock = 33;
rciBLOBDeleted = 34;
rciBLOBContentBlockSignature = 35;
rciBLOBContentSegSignature = 36;
rciBLOBInvalidRefNr = 37;
rciBLOBInvalidLookupRefNr = 38;
rciBLOBInvalidContentRefNr = 39;
rciBLOBHeaderSignature = 40;
rciPackFailure = 41;
rciOrphanedUsedDataBlocks = 42;
rciSplitUsedDataBlocks = 43;
rciNumErrCodes = 43;
{ Verify error strings per error. }
rcErrStr : array[1..rciNumErrCodes] of string =
(
{1} 'Unknown block type: %d.',
{2} 'Invalid block reference, Next Block points to block %d.',
{3} 'Invalid block reference, DataDict points to block %d.',
{4} 'Invalid internal block number. Should be %d but is set to %d.',
{5} 'Invalid block size: %d.',
{6} 'File header DataDictBlockNum does not point to a data dictionary.',
{7} 'Invalid %s, value: %d:%d.',
{8} 'Record count is %d but FirstDataBlock does not point to a data block.',
{9} 'Invalid block reference, FirstDataBlock points to non-data block %d.',
{10} 'Invalid block reference, FirstFreeBlock points to active block %d.',
{11} 'Invalid sequential access index flag in file header, value: %d.',
{12} 'Invalid block reference, IndexHeaderBlockNum points to non-index block %d.',
{13} 'Record count is %d but LastDataBlock does not point to a data block.',
{14} 'Invalid block reference, LastDataBlock points to non-data block %d',
{15} 'Invalid Log2 block size. For block size %d, expected %d but actual value is %d.',
{16} 'Invalid Used Blocks count. Calculated as %d but actual value is %d.',
{17} 'Index header contains %d rows but there are %d indices in the dictionary.',
{18} 'Index header row %d specifies key length of %d but dictionary specifies key length of %d',
{19} 'Index header row %d specifies the index contains %d keys but there are %d records in the table.',
{20} 'No root page specified for row %d of index header',
{21} 'Root page reference in row %d of index header does not point to an index block',
{22} 'Row 0 of index header does not have "keys are reference numbers" flag set',
{23} 'Dictionary indicates index %d allows duplicate keys but the row %d in the index header does not have this flag set',
{24} 'Index block previous page reference points to non-index block %d',
{25} 'Key %d of leaf index block %d (index %d) references block %d',
{26} 'Key %d of leaf index block %d (index %d) points to data block %d but that block is not a data block. The refNum for that key is %d:%d. %s',
{27} 'Key %d of leaf index block %d (index %d) points to data block %d. The RefNum (%d:%d) is invalid for that data block.',
{28} 'Key %d of internal index block %d (index %d) points to index block %d but that block is not an index block. The refNum for that key is %d:%d. %s',
{29} 'Key %d of internal index block %d (index %d) points to data block %d. The RefNum (%d:%d) is invalid for that data block.',
{30} 'Header of data block %d says record count is %d but it is listed as %d records per block in the file header',
{31} 'Header of data block %d says record length is %d but it is listed as %d in the data dictionary',
{32} 'Header of data block %d points to next data block %d but that block is not a data block',
{33} 'Header of data block %d points to previous data block %d but that block is not a data block',
{34} 'The BLOB is marked as deleted (BLOB field "%s", BLOB refnum %d:%d, key fields: %s, record %d of data block %d)',
{35} 'A content block has an invalid signature (BLOB field "%s", BLOB refnum %d:%d, key fields: [%s], record %d of data block %d)',
{36} 'A content segment has an invalid signature (BLOB field "%s", BLOB refnum %d:%d, key fields: [%s], record %d of data block %d)',
{37} 'Invalid BLOB reference number (BLOB field "%s", BLOB refnum %d:%d, key fields: [%s], record %d (base 0) of data block %d)',
{38} 'Invalid BLOB lookup segment reference number (BLOB field "%s", BLOB refnum %d:%d, key fields: [%s], record %d (base 0) of data block %d)',
{39} 'Invalid BLOB content segment reference number (BLOB field "%s", BLOB refnum %d:%d, key fields: [%s], record %d (base 0) of data block %d)',
{40} 'Invalid BLOB header signature (BLOB field "%s", BLOB refnum %d:%d, key fields: [%s], record %d (base 0) of data block %d)',
{41} 'Could not pack table: %s',
{42} 'There are data blocks that are not part of the used data block chain',
{43} 'There are breaks in the chain of used data blocks'
);
{ Recommended actions per error. }
rcAction : array[1..rciNumErrCodes] of TffRepairAction =
(
raSelfRepair, {rciUnknownBlockType}
raDecide, {rciInvalidBlockRefNext}
raDecide, {rciInvalidBlockRefDict}
raSelfRepair, {rciInvalidThisBlock}
raDecide, {rciInvalidBlockSize}
raDecide, {rciNoDictBlock}
raPack, {rciInvalidInt64}
raPack, {rciNoDataBlockForRecs}
raPack, {rciInvalidBlockRefFirstData}
raPack, {rciInvalidBlockRefFirstFree}
raSelfRepair, {rciInvalidSeqIndexFlag}
raPack, {rciInvalidBlockRefIndexHead}
raPack, {rciNoLastDataBlockForRecs}
raPack, {rciInvalidBlockRefLastData}
raSelfRepair, {rciInvalidLog2BlockSize}
raSelfRepair, {rciInvalidUsedBlocks}
raPack, {rciInxHeaderInvalidRowCount}
raPack, {rciInxHeaderInvalidKeyLen}
raPack, {rciInxHeaderInvalidKeyCount}
raPack, {rciInxHeaderNoRootPage}
raPack, {rciInxHeaderInvalidRootPage}
raPack, {rciInxHeaderNoRefsFlag}
raPack, {rciInxHeaderNoDupsFlag}
raPack, {rciInvalidInxPrefPageRef}
raPack, {rciInxInvalidPageRef}
raPack, {rciInvalidLeafKeyBlockRef}
raPack, {rciInvalidLeafKeyRefNum}
raPack, {rciInalidIntrnalKeyBlockRef}
raPack, {rciInvalidIntrnalKeyRefNum}
raSelfRepair, {rciInvalidDataBlockRecCount}
raSelfRepair, {rciInvalidDataBlockRecLen}
raPack, {rciInvalidNextDataBlock}
raPack, {rciInvalidPrevDataBlock}
raPack, {rciBLOBDeleted}
raPack, {rciBLOBContentBlockSignature}
raPack, {rciBLOBContentSegSignature}
raPack, {rciBLOBInvalidRefNr}
raPack, {rciBLOBInvalidLookupRefNr}
raPack, {rciBLOBInvalidContentRefNr}
raPack, {rciBLOBHeaderSignature}
raUnsalvageable, {rciPackFailure}
raSelfRepair, {rciOrphanedUsedDataBlocks}
raSelfRepair {rciSplitUsedDataBlocks}
);
{ How the problem was repaired. Specify values only for those problems that
can be self-repaired. }
csBLOBRefSetToNull = 'BLOB reference set to null (field "%s", key fields: [%s], record %d of data block %d).';
rcFixStr : array[1..rciNumErrCodes] of string =
(
'Block %d marked as a free block', {rciUnknownBlockType}
'NextBlock set to value %d.', {rciInvalidBlockRefNext}
'', {rciInvalidBlockRefDict}
'ThisBlock set to value %d.', {rciInvalidThisBlock}
'', {rciInvalidBlockSize}
'', {rciNoDictBlock}
'', {rciInvalidInt64}
'', {rciNoDataBlockForRecs}
'', {rciInvalidBlockRefFirstData}
'', {rciInvalidBlockRefFirstFree}
'Sequential index flag set to value %d.', {rciInvalidSeqIndexFlag}
'', {rciInvalidBlockRefIndexHead}
'', {rciNoLastDataBlockForRecs}
'Last Data Block set to value %d.', {rciInvalidBlockRefLastData}
'Log 2 block size set to value %d.', {rciInvalidLog2BlockSize}
'Used block count set to value %d.', {rciInvalidUsedBlocks}
'', {rciInxHeaderInvalidRowCount}
'', {rciInxHeaderInvalidKeyLen}
'', {rciInxHeaderInvalidKeyCount}
'', {rciInxHeaderNoRootPage}
'', {rciInxHeaderInvalidRootPage}
'', {rciInxHeaderNoRefsFlag}
'', {rciInxHeaderNoDupsFlag}
'', {rciInvalidInxPrefPageRef}
'', {rciInxInvalidPageRef}
'', {rciInvalidLeafKeyBlockRef}
'', {rciInvalidLeafKeyRefNum}
'', {rciInvalidIntrnalKeyBlockRef}
'', {rciInvalidIntrnalKeyRefNum}
'Record count in data block %d set to %d.', {rciInvalidDataBlockRecCount}
'Record length in data block %d set to %d.', {rciInvalidDataBlockRecLen}
'', {rciInvalidNextDataBlock}
'', {rciInvalidPrevDataBlock}
csBLOBRefSetToNull, {rciBLOBDeleted}
csBLOBRefSetToNull, {rciBLOBContentBlockSignature}
csBLOBRefSetToNull, {rciBLOBContentSegSignature}
csBLOBRefSetToNull, {rciBLOBInvalidRefNr}
csBLOBRefSetToNull, {rciBLOBInvalidLookupRefNr}
csBLOBRefSetToNull, {rciBLOBInvalidContentRefNr}
csBLOBRefSetToNull, {rciBLOBHeaderSignature}
'', {rciPackFailure}
'Orphaned data blocks added to used block chain.', {rciOrphanedUsedDataBlocks}
'Used data block chain repaired.' {rciSplitUsedDataBlocks}
);
implementation
end.

2360
components/flashfiler/sourcelaz/Verify/ffv2file.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
components/flashfiler/sourcelaz/Verify/frMain.dfm Normal file
View File

Binary file not shown.

858
components/flashfiler/sourcelaz/Verify/frMain.pas Normal file
View File

@ -0,0 +1,858 @@
{*********************************************************}
{* FlashFiler: Main form for verification utility *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit frMain;
interface
uses
Windows, Messages, SysUtils,
{$IFDEF DCC6OrLater}
Variants,
{$ENDIF}
Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, ComCtrls, FFRepair, FFFileInt, StdCtrls;
{ TODO::
Tasks listed by order of development:
- UI: view individual blocks within the file
- display index block data
- display data block data
- test index verify/repair
- file interface needs property to identify if a file is currently opened.
- backup of existing file to another directory
- incorporate chain gang for verification of deleted block chain
- verify/repair data block
- unknown block type error should result in need to restructure
- verify/repair stream block
- BLOB verify/repair
- display file size
- allow max ram of repair engine to be adjusted
- display max ram being used while verify/repair in progress
- duration of verification & repair
FUTURE development tasks:
- handle multi-file tables
- BLOB stats
- View block map of file
}
type
TfrmMain = class(TForm)
pnlTop: TPanel;
mnuMain: TMainMenu;
mnuFile: TMenuItem;
mnuFileOpen: TMenuItem;
mnuFileClose: TMenuItem;
mnuFileSep1: TMenuItem;
mnuFileExit: TMenuItem;
mnuFileSep2: TMenuItem;
mnuFileVerify: TMenuItem;
mnuFileRepair: TMenuItem;
tvMain: TTreeView;
Splitter: TSplitter;
dlgOpen: TOpenDialog;
Notebook: TPageControl;
pgProps: TTabSheet;
lvProps: TListView;
pgData: TTabSheet;
lvData: TListView;
pgStatus: TTabSheet;
pnlStatusBottom: TPanel;
progressBar: TProgressBar;
memStatus: TMemo;
lblStatus: TLabel;
pgRawData: TTabSheet;
lvRawData: TListView;
mnuFileSep3: TMenuItem;
mnuFileViewBlock: TMenuItem;
mnuChain: TMenuItem;
mnuChainViewData: TMenuItem;
mnuChainViewFree: TMenuItem;
pgReadMe: TTabSheet;
memReadMe: TMemo;
mnuOptions: TMenuItem;
procedure FormShow(Sender: TObject);
procedure mnuFileOpenClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mnuFileExitClick(Sender: TObject);
procedure tvMainClick(Sender: TObject);
procedure mnuFileCloseClick(Sender: TObject);
procedure tvMainGetSelectedIndex(Sender: TObject; Node: TTreeNode);
procedure mnuFileVerifyClick(Sender: TObject);
procedure mnuFileRepairClick(Sender: TObject);
procedure NotebookChange(Sender: TObject);
procedure mnuFileViewBlockClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure mnuChainViewDataClick(Sender: TObject);
procedure mnuChainViewFreeClick(Sender: TObject);
procedure mnuOptionsClick(Sender: TObject);
private
{ Private declarations }
FBlockNumToNodeMap : TStringList;
FCurNode : TTreeNode;
FDataBlocksNode : TTreeNode;
FFileHeaderBlock : IFileHeaderBlock;
FFileName : string;
FIndexBlocksNode : TTreeNode;
FLastItem : TffRepairItem;
FOtherBlocksNode : TTreeNode;
FOutputVersion : Longint;
FRepair : TffRepairEngine;
FState : TffRepairState;
FViewedBlocks : TInterfaceList;
procedure ClearAll;
procedure ClearData;
procedure ClearProps;
procedure ClearRawData;
procedure ClearRepair;
procedure ClearStatus;
procedure ClearTreeView;
procedure ClearUI;
procedure DisplayData(const Block : ICommonBlock);
procedure DisplayProps(const Block : ICommonBlock);
procedure DisplayRawData(const Block : ICommonBlock);
procedure LoadUI;
procedure OnComplete(Sender : TObject);
procedure OnProgress(Repairer : TffRepairEngine;
State : TffRepairState;
Item : TffRepairItem;
const ActionStr : string;
const Position, Maximum : Integer);
procedure OnReportError(Block : ICommonBlock;
const ErrCode : Integer;
const ErrorStr : string);
procedure OnReportFix(Block : ICommonBlock;
const ErrCode : Integer;
const RepairStr : string);
procedure PositionToNode(Node : TTreeNode);
procedure ReleaseBlocksAndNodes;
procedure SetCtrlStates;
procedure Status(const Msg : string; args : array of const);
procedure VerifyRepair;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
uses
frmBlock,
FFLLBase,
FFSrBase,
FFRepCnst, frmOptions;
const
csBlock = 'Block %d';
csDataBlocks = 'Data blocks';
csDataDict = 'Data dictionary';
csFileHeader = 'File header';
csIndexBlocks = 'Index blocks';
csIndexHeader = 'Index header';
csOtherBlocks = 'Other blocks';
csStatusSep = '============================================================';
function Singular(const Value : Integer;
const Singular, Plural : string) : string;
begin
Result := IntToStr(Value) + ' ';
if Value = 1 then
Result := Result + Singular
else
Result := Result + Plural;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
ClearTreeView;
NoteBook.ActivePage := pgReadMe;
// NoteBook.ActivePage := pgProps;
SetCtrlStates;
end;
procedure TfrmMain.ClearAll;
begin
ClearRepair;
ClearTreeView;
ClearProps;
ClearData;
ClearRawData;
ClearStatus;
end;
procedure TfrmMain.ClearData;
begin
lvData.Columns.Clear;
lvData.Items.Clear;
end;
procedure TfrmMain.ClearProps;
begin
lvProps.Columns.Clear;
lvProps.Items.Clear;
end;
procedure TfrmMain.ClearRawData;
begin
lvRawData.Columns.Clear;
lvRawData.Items.Clear;
end;
procedure TfrmMain.ClearUI;
begin
ClearTreeView;
ClearProps;
ClearData;
ClearRawData;
{ Note: This method does not clear the status page. }
end;
procedure TfrmMain.ReleaseBlocksAndNodes;
begin
FFileHeaderBlock := nil;
FDataBlocksNode := nil;
FIndexBlocksNode := nil;
FOtherBlocksNode := nil;
FViewedBlocks.Clear;
end;
procedure TfrmMain.ClearRepair;
begin
if FRepair <> nil then begin
ReleaseBlocksAndNodes;
FRepair.Free;
FRepair := nil;
end;
end;
procedure TfrmMain.ClearStatus;
begin
memStatus.Clear;
FLastItem := riNone;
end;
procedure TfrmMain.ClearTreeView;
begin
FCurNode := nil;
tvMain.Items.Clear;
tvMain.Items.Add(nil, '<open a FlashFiler table>');
end;
procedure TfrmMain.DisplayData(const Block : ICommonBlock);
var
Col, ColCount, Row : Integer;
Column : TListColumn;
Item : TListItem;
begin
ClearData;
ColCount := Block.DataColCount;
for Col := 0 to Pred(ColCount) do begin
Column := lvData.Columns.Add;
Column.Caption := Block.DataColCaption[Col];
Column.Width := Block.DataColWidth[Col];
end;
for Row := 0 to Pred(Block.DataRowCount) do begin
Item := lvData.Items.Add;
for Col := 0 to Pred(ColCount) do begin
if Col = 0 then
Item.Caption := Block.DataCell[Row, Col]
else
Item.SubItems.Add(Block.DataCell[Row, Col]);
end; { for }
end; { for }
end;
procedure TfrmMain.DisplayProps(const Block : ICommonBlock);
var
Col, ColCount, Row : Integer;
Column : TListColumn;
Item : TListItem;
begin
ClearProps;
ColCount := Block.PropertyColCount;
for Col := 0 to Pred(ColCount) do begin
Column := lvProps.Columns.Add;
Column.Caption := Block.PropertyColCaption[Col];
Column.Width := Block.PropertyColWidth[Col];
end;
for Row := 0 to Pred(Block.PropertyRowCount) do begin
Item := lvProps.Items.Add;
for Col := 0 to Pred(ColCount) do begin
if Col = 0 then
Item.Caption := Block.PropertyCell[Row, Col]
else
Item.SubItems.Add(Block.PropertyCell[Row, Col]);
end; { for }
end; { for }
end;
procedure TfrmMain.DisplayRawData(const Block : ICommonBlock);
var
Row : Integer;
Column : TListColumn;
Item : TListItem;
RawData : PffBlock;
Strings : TStringList;
begin
ClearRawData;
RawData := Block.RawData;
Strings := TStringList.Create;
try
{ Format the raw data. }
GenerateHexLines(RawData, FFileHeaderBlock.BlockSize, Strings);
{ Set up the columns. }
Column := lvRawData.Columns.Add;
Column.Caption := 'Offset';
Column.Width := 70;
Column := lvRawData.Columns.Add;
Column.Caption := 'Bytes';
Column.Width := 475;
for Row := 0 to Pred(Strings.Count) do begin
Item := lvRawData.Items.Add;
Item.Caption := LongintToHex(Row * 16);
Item.SubItems.Add(Strings[Row]);
end;
finally
Strings.Free;
end;
end;
procedure TfrmMain.LoadUI;
var
DictRootNode,
FileHeaderNode,
RootNode : TTreeNode;
Inx : Integer;
DictBlock : IStreamBlock;
IndexHeaderBlock : IIndexHeaderBlock;
begin
{ Set up the tree view. Display a root node identifying the file. Add
child nodes that provide access to the header block, dictionary blocks,
& index header. }
tvMain.Items.Clear;
RootNode := tvMain.Items.Add(nil, ExtractFileName(FFileName));
FFileHeaderBlock := FRepair.GetFileHeaderBlock;
FileHeaderNode := tvMain.Items.AddChildObject(RootNode, csFileHeader,
Pointer(FFileHeaderBlock));
DictRootNode := tvMain.Items.AddChild(RootNode, csDataDict);
for Inx := 0 to Pred(FRepair.DictBlockCount) do begin
DictBlock := FRepair.DictBlocks[Inx];
tvMain.Items.AddChildObject(DictRootNode,
Format(csBlock,
[DictBlock.BlockNum]),
Pointer(DictBlock));
FViewedBlocks.Add(DictBlock);
end;
{ Create a node for the index header. }
IndexHeaderBlock := FRepair.GetIndexHeaderBlock;
tvMain.Items.AddChildObject(RootNode, csIndexHeader,
Pointer(IndexHeaderBlock));
FViewedBlocks.Add(IndexHeaderBlock);
{ Create nodes for viewed data, index, & other blocks. }
FDataBlocksNode := tvMain.Items.AddChild(RootNode, csDataBlocks);
FIndexBlocksNode := tvMain.Items.AddChild(RootNode, csIndexBlocks);
FOtherBlocksNode := tvMain.Items.AddChild(RootNode, csOtherBlocks);
{ By default, select the file header node & display its information. }
RootNode.Expand(True);
PositionToNode(FileHeaderNode);
end;
procedure TfrmMain.mnuFileOpenClick(Sender: TObject);
begin
if dlgOpen.Execute then begin
FFileName := dlgOpen.FileName;
ClearAll;
FRepair := TffRepairEngine.Create;
FRepair.Open(FFileName);
LoadUI;
end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClearRepair;
end;
procedure TfrmMain.mnuFileExitClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.tvMainClick(Sender: TObject);
var
Node : TTreeNode;
begin
Node := tvMain.Selected;
if (Node <> nil) and (Node <> FCurNode) then begin
{ Set up the list view columns. Raw data will be displayed when the user
views that page. }
ClearRawData;
if Node.Data <> nil then begin
DisplayProps(ICommonBlock(Node.Data));
DisplayData(ICommonBlock(Node.Data));
if Notebook.ActivePage = pgRawData then
DisplayRawData(ICommonBlock(Node.Data))
else if (FState = rmIdle) and (NoteBook.ActivePage = pgStatus) then
{ If state is idle (i.e., we did not just finish repairing) &
on the status page then switch to the props page. }
NoteBook.ActivePage := pgProps;
end
else begin
ClearProps;
ClearData;
end;
FCurNode := Node;
end
else if (Node <> nil) and (FState = rmIdle) and
(Notebook.ActivePage = pgStatus) then
{ If user clicked on the current node & the status page is displayed then
flip over to the properties page. }
NoteBook.ActivePage := pgProps;
end;
procedure TfrmMain.mnuFileCloseClick(Sender: TObject);
begin
if FRepair <> nil then
ClearAll;
end;
procedure TfrmMain.tvMainGetSelectedIndex(Sender: TObject;
Node: TTreeNode);
begin
tvMainClick(Sender);
end;
procedure TfrmMain.OnComplete(Sender : TObject);
var
Action, HighestAction : TffRepairAction;
Inx : Integer;
SelfRepairing : Boolean;
AbortMsg,
Recommendation,
StatusMsg,
RepairedErrSummary,
Summary : string;
begin
progressBar.Position := 0;
Status(csStatusSep, []);
{ Determine the highest repair action. }
SelfRepairing := False;
HighestAction := raDecide;
for Inx := 0 to Pred(FRepair.ErrorCount) do begin
Action := rcAction[FRepair.ErrorCodes[Inx]];
if Action = raSelfRepair then
SelfRepairing := True;
if Action > HighestAction then
HighestAction := Action;
end; { for }
if FState = rmVerify then begin
lblStatus.Caption := 'Verification complete.';
if FRepair.ErrorCount = 0 then
StatusMsg := 'Verification complete. No errors were found.'
else begin
StatusMsg := Format('Verification complete. Found %s.',
[Singular(FRepair.ErrorCount, 'error', 'errors')]);
if FRepair.Aborted then
AbortMsg := 'The error limit was reached. There may be additional errors.';
{ Build a summary/recommended course of action. }
case HighestAction of
raSelfRepair :
begin
Summary := 'All errors can be successfully repaired without ' +
'packing the file.';
Recommendation := 'Allow this utility to repair the file.';
end;
raDecide, raPack :
begin
if SelfRepairing then begin
Summary := 'Some of the errors can be manually repaired ' +
'but other errors require the file to be packed.';
Recommendation := 'Allow this utility to repair and restructure ' +
'the file.';
end
else begin
Summary := 'The errors in the file require the file to be ' +
'packed.';
Recommendation := 'Allow this utility to pack the file.';
end;
end;
raUnsalvageable :
begin
Summary := 'The file and its data cannot be salvaged.';
Recommendation := 'Restore this file from the last known good backup.';
end;
end; { case }
if FRepair.Aborted then
StatusMsg := StatusMsg + #13#10#13#10 + AbortMsg;
StatusMsg := StatusMsg + #13#10#13#10 + Summary + #13#10#13#10 +
Recommendation;
end; { if }
end
else begin
lblStatus.Caption := 'Repair complete.';
if FRepair.ErrorCount = 0 then
StatusMsg := 'Repair complete. No errors were found.'
else begin
{ Generate a summary count for found & repaired errors. }
RepairedErrSummary := Format('Found %s and repaired %s.',
[Singular(FRepair.ErrorCount, 'error', 'errors'),
Singular(FRepair.FixCount, 'error', 'errors')]);
{ Did a pack or reindex fail? }
if HighestAction = raUnsalvageable then
StatusMsg := 'Repair did not complete successfully. ' +
RepairedErrSummary
else begin
{ No, the repair was entirely successful. Indicate if table was packed
or reindex. }
if HighestAction = raPack then
RepairedErrSummary := RepairedErrSummary +
' The table was packed.';
StatusMsg := 'Repair complete. ' + RepairedErrSummary;
end; { if..else }
end; { if..else }
end;
Status(StatusMsg, []);
Status(csStatusSep, []);
ShowMessage(StatusMsg);
end;
procedure TfrmMain.OnProgress(Repairer : TffRepairEngine;
State : TffRepairState;
Item : TffRepairItem;
const ActionStr : string;
const Position, Maximum : Integer);
begin
ProgressBar.Min := 1;
ProgressBar.Max := Maximum;
ProgressBar.Position := Position;
lblStatus.Caption := ActionStr;
if Item <> FLastItem then begin
Status(ActionStr, []);
FLastItem := Item;
end;
Application.ProcessMessages;
end;
procedure TfrmMain.OnReportError(Block : ICommonBlock;
const ErrCode : Integer;
const ErrorStr : string);
begin
if Block = nil then
Status('Error %d: %s', [ErrCode, ErrorStr])
else
Status('Block %d (%d): %s', [Block.BlockNum, ErrCode, ErrorStr]);
end;
procedure TfrmMain.OnReportFix(Block : ICommonBlock;
const ErrCode : Integer;
const RepairStr : string);
begin
if Block = nil then
Status('..Fix, code %d: %s', [ErrCode, RepairStr])
else
Status('..Block %d (%d): %s', [Block.BlockNum, ErrCode, RepairStr]);
end;
procedure TfrmMain.Status(const Msg : string; args : array of const);
begin
memStatus.Lines.Add(Format(Msg, args));
Application.ProcessMessages;
end;
procedure TfrmMain.mnuFileVerifyClick(Sender: TObject);
begin
if FState = rmIdle then begin
FState := rmVerify;
try
VerifyRepair;
finally
Application.ProcessMessages;
FState := rmIdle;
end;
end
else
ShowMessage('Verify can be performed only when this utility is Idle.');
end;
procedure TfrmMain.SetCtrlStates;
var
Opened : Boolean;
begin
Opened := (FRepair <> nil);
mnuFileClose.Enabled := Opened;
mnuFileVerify.Enabled := Opened;
mnuFileRepair.Enabled := Opened;
mnuChainViewData.Enabled := Opened;
mnuChainViewFree.Enabled := Opened;
mnuFileViewBlock.Enabled := Opened;
end;
procedure TfrmMain.mnuFileRepairClick(Sender: TObject);
begin
if FState = rmIdle then begin
FState := rmRepair;
try
ReleaseBlocksAndNodes;
ClearUI;
Application.ProcessMessages;
VerifyRepair;
finally
LoadUI;
Application.ProcessMessages;
FState := rmIdle;
end;
end
else
ShowMessage('Repair can be performed only when this utility is Idle.');
end;
procedure TfrmMain.VerifyRepair;
var
SavCursor : TCursor;
begin
if FRepair <> nil then begin
Notebook.ActivePage := pgStatus;
SavCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
try
ClearStatus;
FRepair.OnComplete := OnComplete;
FRepair.OnProgress := OnProgress;
FRepair.OnReportError := OnReportError;
FRepair.OnReportFix := OnReportFix;
if FState = rmVerify then
FRepair.Verify
else begin
FRepair.OutputVersion := FOutputVersion;
FRepair.Repair;
end;
finally
Screen.Cursor := SavCursor;
end;
end; { if }
end;
procedure TfrmMain.NotebookChange(Sender: TObject);
var
Node : TTreeNode;
begin
if (Notebook.ActivePage = pgRawData) and (lvRawData.Items.Count = 0) then begin
Node := tvMain.Selected;
if (Node <> nil) and (Node.Data <> nil) then
DisplayRawData(ICommonBlock(Node.Data));
end;
end;
procedure TfrmMain.mnuFileViewBlockClick(Sender: TObject);
var
BlockNumber : TffWord32;
Block : ICommonBlock;
Inx : Integer;
Node : TTreeNode;
begin
{ Have the user enter the block number. }
if Assigned(FFileHeaderBlock) then
with TfrmBlockNum.Create(nil) do
try
MaxBlockNum := Pred(FFileHeaderBlock.UsedBlocks);
ShowModal;
BlockNumber := BlockNum;
{ If a block number was specified, see if it is the same as
an existing node or if a new node must be added. }
if BlockNumber <> ffc_W32NoValue then begin
(* { TODO:: If this is a preloaded block then go to the appropriate tree node. }
if BlockNumber = xxx then
else if BlockNumber = xxx then
else if BlockNumber = xxx then
else if BlockNumber = xxx then
else if BlockNumber = xxx then*)
{ Determine if this is already available via an existing node in the
tree. }
Inx := FBlockNumToNodeMap.IndexOf(IntToStr(BlockNumber));
if Inx > -1 then begin
end
else begin
{ The block has not been viewed. Load the block & put it into the
tree view. }
Block := FRepair.GetBlock(BlockNumber);
FViewedBlocks.Add(Block);
if Block.Signature = ffc_SigDataBlock then begin
{ Add this under the data blocks node. }
Node := tvMain.Items.AddChildObject(FDataBlocksNode,
Format(csBlock,
[Block.BlockNum]),
Pointer(Block));
end
else if Block.Signature = ffc_SigIndexBlock then begin
{ Add this under the index blocks node. }
Node := tvMain.Items.AddChildObject(FIndexBlocksNode,
Format(csBlock,
[Block.BlockNum]),
Pointer(Block));
end
else begin
{ Add this under the other blocks node. }
Node := tvMain.Items.AddChildObject(FOtherBlocksNode,
Format(csBlock,
[Block.BlockNum]),
Pointer(Block));
end; { if..else }
{ Add this block to the blocknumber-to-node map. }
FBlockNumToNodeMap.AddObject(IntToStr(BlockNumber), Node);
{ Position the tree view to the node. }
PositionToNode(Node);
end;
end;
finally
Free;
end;
end;
procedure TfrmMain.PositionToNode(Node : TTreeNode);
begin
tvMain.Selected := Node;
{$IFDEF DCC6OrLater}
tvMain.Select(Node);
{$ELSE}
tvMain.Selected := Node;
{$ENDIF}
Node.Focused := True;
Node.Selected := True;
FCurNode := Node;
SetCtrlStates;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FBlockNumToNodeMap := TStringList.Create;
with TffVerifyOptions.Create do
try
FOutputVersion := OutputVersion;
finally
Free;
end;
FViewedBlocks := TInterfaceList.Create;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FViewedBlocks.Free;
FBlockNumToNodeMap.Free;
end;
procedure TfrmMain.mnuChainViewDataClick(Sender: TObject);
var
SavCursor : TCursor;
begin
if FRepair <> nil then begin
Notebook.ActivePage := pgStatus;
SavCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
FState := rmAcquireInfo;
try
ClearStatus;
memStatus.Text := FRepair.GetDataChainDetails.Text;
finally
FState := rmIdle;
Screen.Cursor := SavCursor;
end;
end;
end;
procedure TfrmMain.mnuChainViewFreeClick(Sender: TObject);
var
SavCursor : TCursor;
begin
if FRepair <> nil then begin
Notebook.ActivePage := pgStatus;
SavCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
FState := rmAcquireInfo;
try
ClearStatus;
memStatus.Text := FRepair.GetFreeChainDetails.Text;
finally
FState := rmIdle;
Screen.Cursor := SavCursor;
end;
end;
end;
procedure TfrmMain.mnuOptionsClick(Sender: TObject);
var
Options : TfrmOptionsConfig;
begin
Options := TfrmOptionsConfig.Create(nil);
try
Options.ShowModal;
if Options.ModalResult = mrOK then
FOutputVersion := Options.OutputVersion;
finally
Options.Free;
end;
end;
end.

BIN
components/flashfiler/sourcelaz/Verify/frmBlock.dfm Normal file
View File

Binary file not shown.

119
components/flashfiler/sourcelaz/Verify/frmBlock.pas Normal file
View File

@ -0,0 +1,119 @@
{*********************************************************}
{* FlashFiler: Input form for block to be viewed *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit frmBlock;
interface
uses
{$IFDEF DCC6OrLater}
Variants,
{$ENDIF}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FFLLBase;
type
TfrmBlockNum = class(TForm)
edtBlockNum: TEdit;
pbOK: TButton;
pbCancel: TButton;
lblBlockNum: TLabel;
lblValidRange: TLabel;
procedure FormShow(Sender: TObject);
procedure edtBlockNumKeyPress(Sender: TObject; var Key: Char);
procedure pbOKClick(Sender: TObject);
procedure pbCancelClick(Sender: TObject);
procedure edtBlockNumChange(Sender: TObject);
private
{ Private declarations }
FBlockNum : TffWord32;
FMaxBlockNum : TffWord32;
public
{ Public declarations }
procedure SetCtrlStates;
property BlockNum : TffWord32 read FBlockNum write FBlockNum;
property MaxBlockNum : TffWord32 read FMaxBlockNum write FMaxBlockNum;
end;
var
frmBlockNum: TfrmBlockNum;
implementation
{$R *.dfm}
procedure TfrmBlockNum.FormShow(Sender: TObject);
begin
FBlockNum := ffc_W32NoValue;
edtBlockNum.SetFocus;
lblValidRange.Caption := Format('Valid range is 0 to %d', [FMaxBlockNum]);
SetCtrlStates;
end;
procedure TfrmBlockNum.edtBlockNumKeyPress(Sender: TObject; var Key: Char);
begin
if (Key <> Char(8)) and ((Key < '0') or (Key > '9')) then begin
Key := Char(0);
Beep;
end;
end;
procedure TfrmBlockNum.pbOKClick(Sender: TObject);
begin
FBlockNum := StrToInt(edtBlockNum.Text);
Close;
end;
procedure TfrmBlockNum.pbCancelClick(Sender: TObject);
begin
Close;
end;
procedure TfrmBlockNum.SetCtrlStates;
var
BlockNum : TffWord32;
begin
if edtBlockNum.Text <> '' then begin
BlockNum := StrToInt(edtBlockNum.Text);
pbOK.Enabled := (edtBlockNum.Text <> '') and
(BlockNum <= FMaxBlockNum);
end
else
pbOK.Enabled := False;
end;
procedure TfrmBlockNum.edtBlockNumChange(Sender: TObject);
begin
SetCtrlStates;
end;
end.

BIN
components/flashfiler/sourcelaz/Verify/frmOptions.dfm Normal file
View File

Binary file not shown.

198
components/flashfiler/sourcelaz/Verify/frmOptions.pas Normal file
View File

@ -0,0 +1,198 @@
{*********************************************************}
{* FlashFiler: Options configuration *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit frmOptions;
interface
uses
{$IFDEF DCC6OrLater}
Variants,
{$ENDIF}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TffVerifyOptions = class
protected
FOutputVersion : Longint;
procedure Load;
public
constructor Create;
procedure Save;
property OutputVersion : Longint
read FOutputVersion write FOutputVersion;
end;
TfrmOptionsConfig = class(TForm)
pnlBottom: TPanel;
pbOK: TButton;
pbCancel: TButton;
pnlClient: TPanel;
lblVersion: TLabel;
efVersion: TEdit;
lblValidRange: TLabel;
procedure pbOKClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure efVersionKeyPress(Sender: TObject; var Key: Char);
procedure efVersionChange(Sender: TObject);
private
{ Private declarations }
FOptions : TffVerifyOptions;
function GetOutputVersion : Longint;
procedure SetCtrlStates;
function ValidVersion : Boolean;
public
{ Public declarations }
property OutputVersion : Longint
read GetOutputVersion;
end;
var
frmOptionsConfig: TfrmOptionsConfig;
implementation
uses
ffllbase,
IniFiles;
{$R *.dfm}
const
cIniFile = 'FFVerify.ini';
cSect = 'Options';
cVersion = 'OutputVersion';
{===TffVerifyOptions=================================================}
constructor TffVerifyOptions.Create;
begin
inherited;
Load;
end;
{--------}
procedure TffVerifyOptions.Load;
begin
with TIniFile.Create(cIniFile) do
try
FOutputVersion := ReadInteger(cSect, cVersion, ffVersionNumber);
finally
Free;
end;
end;
{--------}
procedure TffVerifyOptions.Save;
begin
with TIniFile.Create(cIniFile) do
try
WriteInteger(cSect, cVersion, FOutputVersion);
finally
Free;
end;
end;
{====================================================================}
procedure TfrmOptionsConfig.pbOKClick(Sender: TObject);
begin
ModalResult := mrOK;
FOptions.OutputVersion := GetOutputVersion;
FOptions.Save;
FOptions.Free;
end;
procedure TfrmOptionsConfig.FormShow(Sender: TObject);
begin
{ Read the options from the INI file. }
FOptions := TffVerifyOptions.Create;
efVersion.Text := IntToStr(FOptions.OutputVersion);
lblValidRange.Caption := Format('Valid range: %d to %d',
[ffVersion2_10, ffVersionNumber]);
SetCtrlStates;
efVersion.SetFocus;
end;
function TfrmOptionsConfig.GetOutputVersion : Longint;
var
TmpStr,
VerStr : string;
TmpLen,
SrcInx,
TgtInx : Integer;
begin
{ Strip out all decimal points. }
TmpStr := efVersion.Text;
TmpLen := Length(TmpStr);
SetLength(VerStr, TmpLen);
TgtInx := 1;
for SrcInx := 1 to TmpLen do
if TmpStr[SrcInx] in ['0'..'9'] then begin
VerStr[TgtInx] := TmpStr[SrcInx];
inc(TgtInx);
end;
SetLength(VerStr, Pred(TgtInx));
Result := StrToInt(VerStr);
end;
function TfrmOptionsConfig.ValidVersion : Boolean;
var
Version : Longint;
begin
try
Version := GetOutputVersion;
{ The version # is valid if it an integer between 21000 and the current
FF version. }
Result := (Version >= ffVersion2_10) and (Version <= ffVersionNumber);
except
Result := False;
end;
end;
procedure TfrmOptionsConfig.efVersionKeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#8, '0'..'9', '.']) then begin
Beep;
Key := #0;
end;
end;
procedure TfrmOptionsConfig.SetCtrlStates;
begin
pbOK.Enabled := ValidVersion;
end;
procedure TfrmOptionsConfig.efVersionChange(Sender: TObject);
begin
SetCtrlStates;
end;
end.

9
components/flashfiler/sourcelaz/Verify/readme.txt Normal file
View File

@ -0,0 +1,9 @@
README: FFVerify
The FFVerify utility may be used to verify and repair FlashFiler 2
tables.
FFVerify was never officially released with FlashFiler 2 and should be
considered alpha quality.
FFVerify compiles with Delphi 5 and higher.

54
components/flashfiler/sourcelaz/bde2ff/bde2ff.dpr Normal file
View File

@ -0,0 +1,54 @@
{*********************************************************}
{* Project source file *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
program Bde2ff;
{$I ffdefine.inc}
uses
{$IFDEF USETeDEBUG}
TeDebug,
{$ENDIF}
ffllbase,
ffllprot,
SysUtils,
Forms,
fmmain in 'fmmain.pas' {frmMain},
dgimpdo in 'dgimpdo.pas' {dlgImportProgress};
{$R *.RES}
begin
Application.Initialize;
Application.HelpFile := 'BDE2FF.DPR';
Application.CreateForm(TfrmMain, frmMain);
Application.CreateForm(TdlgImportProgress, dlgImportProgress);
Application.Run;
end.

60
components/flashfiler/sourcelaz/bde2ff/bde2ff.rc Normal file
View File

@ -0,0 +1,60 @@
/*********************************************************
* Main program icon resource *
*********************************************************/
/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */
#define VERSIONINFO_1 1
VERSIONINFO_1 VERSIONINFO
FILEVERSION 2, 1, 3, 0
PRODUCTVERSION 2, 1, 3, 0
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
{
BLOCK "StringFileInfo"
{
BLOCK "040904E4"
{
VALUE "CompanyName", "TurboPower Software Company\000\000"
VALUE "FileDescription", "FlashFiler BDE2FF\000"
VALUE "FileVersion", "2.1.3.0\000"
VALUE "InternalName", "BDE2FF\000"
VALUE "LegalCopyright", "Copyright (c) TurboPower Software Co. 1996-2002\000\000"
VALUE "OriginalFilename", "BDE2FF.EXE\000"
VALUE "ProductName", "FlashFiler (Delphi Edition)\000"
VALUE "ProductVersion", "2.1.3.0\000"
}
}
BLOCK "VarFileInfo"
{
VALUE "Translation", 0x409, 1252
}
}

BIN
components/flashfiler/sourcelaz/bde2ff/bde2ff.res Normal file
View File

Binary file not shown.

BIN
components/flashfiler/sourcelaz/bde2ff/dgimpdo.dfm Normal file
View File

Binary file not shown.

575
components/flashfiler/sourcelaz/bde2ff/dgimpdo.pas Normal file
View File

@ -0,0 +1,575 @@
{*********************************************************}
{* Progress meter for import operations *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
unit dgimpdo;
interface
uses
Windows,
SysUtils,
Dialogs,
Classes,
DBTables,
Graphics,
Forms,
Controls,
StdCtrls,
DB,
Buttons,
ExtCtrls,
Gauges,
dbconsts,
bde,
bdeconst,
ffllbase,
ffsrbde,
ffdb,
ffdbbase;
type
TdlgImportProgress = class(TForm)
Bevel1: TBevel;
lblProgress: TLabel;
btnCancel: TBitBtn;
Label1: TLabel;
Label2: TLabel;
edtImportFilename: TEdit;
edtTablename: TEdit;
guaProgress: TGauge;
procedure btnCancelClick(Sender: TObject);
private
public
Terminated : Boolean;
procedure ShowProgress(aImportFilename, aTableName : string);
procedure UpdateProgress(aNumRead, aTotalRecs : Longint);
end;
procedure ConvertBDEDataType(aDataType : TFieldType;
aSize : LongInt;
var aFFType : TffFieldType;
var aFFSize : LongInt;
var aFFDecPl : Integer);
function DoImport(aSourceTable : TTable; { Table to copy from }
aSourceFields : TStringList; { List of field #'s to copy }
aDestTable : TffTable; { Table to copy to }
aBlockInserts : SmallInt; { Transaction batch size }
var aNumTransferred : LongInt): Boolean; { Number of records copied }
var
dlgImportProgress : TdlgImportProgress;
implementation
{$R *.DFM}
uses
ffclintf,
fmmain;
procedure ConvertBDEDataType(aDataType : TFieldType;
aSize : LongInt;
var aFFType : TffFieldType;
var aFFSize : LongInt;
var aFFDecPl : Integer);
begin
aFFSize := aSize;
aFFDecPl := 0;
case aDatatype of
{$IFDEF DCC4OrLater}
ftFixedChar,
{$ENDIF}
ftString :
{Begin !!.01}
if aSize <= 255 then begin
{Begin !!.11}
if frmMain.chkUseANSIFields.Checked then begin
if frmMain.chkUseZeroTerminatedStrings.Checked then
aFFType := fftNullAnsiStr
else
aFFType := fftShortAnsiStr
end
else begin
if frmMain.chkUseZeroTerminatedStrings.Checked then
aFFType := fftNullString
else
aFFType := fftShortString;
end
{End !!.11}
end
else begin
if frmMain.chkUseANSIFields.Checked then
aFFType := fftNullAnsiStr
else
aFFType := fftNullString;
end;
{End !!.01}
ftSmallint:
aFFType := fftInt16;
ftInteger:
aFFType := fftInt32;
ftWord:
aFFType := fftWord16;
ftBoolean:
aFFType := fftBoolean;
ftFloat:
aFFType := fftDouble;
ftCurrency:
aFFType := fftCurrency;
ftBCD:
aFFType := fftDouble;
ftDate:
{Begin !!.11}
if frmMain.chkUseSysToolsDates.Checked then
aFFType := fftStDate
else
aFFType := fftDateTime;
{End !!.11}
ftTime:
{Begin !!.11}
if frmMain.chkUseSysToolsTimes.Checked then
aFFType := fftStTime
else
aFFType := fftDateTime;
{End !!.11}
ftDateTime:
aFFType := fftDateTime;
ftBytes,
ftVarBytes:
aFFType := fftByteArray;
ftBlob:
aFFType := fftBLOB;
ftMemo:
aFFType := fftBLOBMemo;
ftGraphic:
aFFType := fftBLOBGraphic;
ftAutoInc:
aFFType := fftAutoInc;
ftFmtMemo:
aFFType := fftBLOBFmtMemo;
ftParadoxOle,
ftDBaseOle:
aFFType := fftBLOBOleObj;
ftTypedBinary:
aFFType := fftBLOBTypedBin;
end;
end;
function DoImport(aSourceTable : TTable;
aSourceFields : TStringList;
aDestTable : TffTable;
aBlockInserts : SmallInt;
var aNumTransferred : LongInt) : Boolean;
resourcestring
SInvalidFieldKind = 'Invalid Field Conversion %s <- %s';
var
FieldNo : Integer;
DestFieldNo : Integer;
TotalRecs : Longint;
DoThisOne : Boolean;
DoExplicitTrans : Boolean;
InTransaction : Boolean;
MaxAutoInc : Integer;
TempStr : string; {!!.01}
procedure CopyField(aDestField, aSourceField : TField);
var
Buffer : Pointer;
Stream : TMemoryStream;
begin
{Begin !!.11}
if aSourceField.IsNull then begin
if frmMain.chkEmptyStrings.Checked and
(aSourceField.Datatype = ftString) then
aDestField.AsString := ''
else
aDestField.Clear;
end
else
{End !!.11}
case aSourceField.Datatype of
ftBoolean:
case aDestField.Datatype of
ftBoolean:
aDestField.AsBoolean := aSourceField.AsBoolean;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
ftString:
case aDestField.Datatype of
ftString:
begin
{Begin !!.11}
if frmMain.chkClearEmptyStrings.Checked then begin
TempStr := aSourceField.AsString;
if TempStr = '' then
aDestField.Clear
else
aDestField.AsString := TempStr;
end
else
aDestField.AsString := aSourceField.AsString;
{End !!.11}
{Begin !!.01}
if frmMain.chkOEMAnsi.Checked and
(Length(aDestField.AsString) > 0) then begin
SetLength(TempStr, Length(aDestField.AsString));
tempStr := aDestField.AsString;
OEMToCharBuff(PChar(tempStr), PChar(tempStr), Length(aDestField.AsString));
aDestField.AsString := tempStr;
end;
{End !!.01}
end;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
ftAutoInc,
ftSmallint,
ftInteger,
ftWord:
case aDestField.Datatype of
ftSmallInt,
ftInteger,
ftAutoInc,
ftWord:
begin
aDestField.AsInteger := aSourceField.AsInteger;
if (aDestField.Datatype = ftAutoInc) and
(aDestField.AsInteger > MaxAutoInc) then
MaxAutoInc := aDestField.AsInteger;
end;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
ftBCD,
ftFloat,
ftCurrency:
case aDestField.Datatype of
ftFloat,
ftCurrency:
aDestField.AsFloat := aSourceField.AsFloat;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
ftDate:
case aDestField.Datatype of
ftDate,
ftDateTime:
aDestField.AsDateTime := aSourceField.AsDateTime;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
ftTime:
case aDestField.Datatype of
ftTime,
ftDateTime:
aDestField.AsDateTime := aSourceField.AsDateTime;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
ftDateTime:
case aDestField.Datatype of
ftDate,
ftTime,
ftDateTime:
aDestField.AsDateTime := aSourceField.AsDateTime;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
ftBytes,
ftVarBytes:
begin
GetMem(Buffer, aDestField.DataSize);
try
case aDestField.Datatype of
ftBytes,
ftVarBytes:
if aSourceField.GetData(Buffer) then
aDestField.SetData(Buffer)
else
aDestField.SetData(nil);
ftFmtMemo,
ftParadoxOle,
ftDBaseOle,
ftTypedBinary,
ftMemo,
ftGraphic,
ftBlob:
if not aSourceField.GetData(Buffer) then
aDestField.SetData(nil)
else begin
Stream := TMemoryStream.Create;
try
Stream.Write(Buffer^, aSourceField.DataSize);
TBLOBField(aDestField).LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
finally
FreeMem(Buffer, aDestField.DataSize);
end;
end;
ftFmtMemo,
ftParadoxOle,
ftDBaseOle,
ftTypedBinary,
ftMemo,
ftGraphic,
ftBlob:
begin
case aDestField.Datatype of
ftFmtMemo,
ftParadoxOle,
ftDBaseOle,
ftTypedBinary,
ftMemo,
ftGraphic,
ftBlob:
begin
Stream := TMemoryStream.Create;
try
TBLOBField(aSourceField).SaveToStream(Stream);
TBLOBField(aDestField).LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
else
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
end;
ftUnknown:
DatabaseErrorFmt(SInvalidFieldKind, [aDestField.DisplayName,
aSourceField.DisplayName]);
end;
end;
begin
Result := False;
with dlgImportProgress do begin
Terminated := False;
ShowProgress(aSourceTable.TableName, aDestTable.TableName);
try
{ If we only have one insert per transaction, then let the server
do implicit transactions; it'll be faster }
if aBlockInserts = 0 then aBlockInserts := 1;
DoExplicitTrans := (aBlockInserts > 1);
aSourceTable.Open;
try
TotalRecs := aSourceTable.RecordCount;
aNumTransferred := 0;
aDestTable.Open;
if (DoExplicitTrans) then {!!.05}
DoExplicitTrans := (not aDestTable.Dictionary.HasBLOBFields);{!!.05}
try
MaxAutoInc := 0;
InTransaction := False;
try
while not aSourceTable.EOF do begin
// UpdateProgress(aNumTransferred + 1, TotalRecs); {Deleted !!.01}
{ Blocks inserts within a transaction }
if DoExplicitTrans and not InTransaction then begin
frmMain.dbDest.StartTransaction;
InTransaction := True;
end;
aDestTable.Insert;
{ Copy fields one at a time }
for FieldNo := 0 to aSourceTable.FieldCount - 1 do begin
{ Do only selected fields }
DoThisOne := not Assigned(aSourceFields);
if not DoThisOne then begin
DoThisOne := aSourceFields.IndexOf(ANSIUppercase(aSourceTable.Fields[FieldNo].FieldName)) <> -1;
end;
if DoThisOne then begin
{ Fields might be in order, avoid expensive FieldByName }
if (FieldNo < aDestTable.FieldCount) and
(FFCmpShStrUC(aSourceTable.Fields[FieldNo].FieldName,
aDestTable.Fields[FieldNo].FieldName,
255) = 0) then
DestFieldNo := FieldNo
else begin
try
DestFieldNo := aDestTable.FieldByName(aSourceTable.Fields[FieldNo].FieldName).FieldNo - 1;
except
DestFieldNo := -1;
end;
end;
if DestFieldNo <> -1 then
try
{Begin !!.11}
// aDestTable.Fields[DestFieldNo].Assign(aSourceTable.Fields[FieldNo]);
{Begin !!.01}
// if frmMain.chkOEMAnsi.Checked and
// (aDestTable.Fields[DestFieldNo].Datatype = ftString) and
// (Length(aDestTable.Fields[DestFieldNo].AsString) > 0) then begin
// SetLength(TempStr, Length(aDestTable.Fields[DestFieldNo].AsString));
// tempStr := aDestTable.Fields[DestFieldNo].AsString;
// OEMToCharBuff(PChar(tempStr), PChar(tempStr), Length(aDestTable.Fields[DestFieldNo].AsString));
// aDestTable.Fields[DestFieldNo].AsString := tempStr;
// end;
{End !!.01}
CopyField(aDestTable.Fields[DestFieldNo], aSourceTable.Fields[FieldNo]);
{End !!.11}
if (aDestTable.Fields[DestFieldNo].Datatype = ftAutoInc) and
(aDestTable.Fields[DestFieldNo].AsInteger > MaxAutoInc) then
MaxAutoInc := aDestTable.Fields[DestFieldNo].AsInteger;
except
on E:EDatabaseError do begin
CopyField(aDestTable.Fields[DestFieldNo], aSourceTable.Fields[FieldNo]);
end;
else
raise;
end;
end;
end;
aDestTable.Post;
Inc(aNumTransferred); { Increment after successfully posting }
{ See if it's time to commit the transaction }
{Begin !!.01}
if InTransaction then begin
if ((aNumTransferred mod aBlockInserts) = 0) then begin
aDestTable.Database.Commit;
UpdateProgress(aNumTransferred, TotalRecs);
InTransaction := False;
end
end
else
UpdateProgress(aNumTransferred + 1, TotalRecs);
{End !!.01}
{ Check for user termination }
if Terminated then begin
if InTransaction then
aDestTable.Database.Rollback;
Exit;
end;
aSourceTable.Next;
end;
{update the maximum autoinc value for the dest table}
aDestTable.SetTableAutoIncValue(MaxAutoInc);
{ Residual inserts need to be posted? }
if InTransaction then begin {!!.01}
aDestTable.Database.Commit;
UpdateProgress(aNumTransferred + 1, TotalRecs); {!!.01}
end; {!!.01}
except
if InTransaction then
aDestTable.Database.Rollback;
raise;
end;
finally
aDestTable.Close;
end;
finally
aSourceTable.Close;
end;
finally
Hide;
end;
Result := not Terminated;
end;
end;
procedure TdlgImportProgress.ShowProgress(aImportFilename, aTableName : string);
begin
edtImportFilename.Text := aImportFilename;
edtTablename.Text := aTableName;
lblProgress.Hide;
guaProgress.Progress := 0;
inherited Show;
Application.ProcessMessages;
end;
procedure TdlgImportProgress.UpdateProgress(aNumRead, aTotalRecs: LongInt);
var
Dividend : LongInt;
Divisor : LongInt;
resourcestring
SProgressStatus = 'Processing record %d of %d';
begin
with lblProgress do begin
Caption := Format(SProgressStatus, [aNumRead, aTotalRecs]);
Show;
Application.ProcessMessages;
end;
{ Calculate % completed }
if (aNumRead >= $1000000) then begin
Dividend := (aNumRead shr 7) * 100;
Divisor := aTotalRecs shr 7;
end
else begin
Dividend := aNumRead * 100;
Divisor := aTotalRecs;
end;
if Divisor <> 0 then
guaProgress.Progress := Dividend div Divisor;
end;
procedure TdlgImportProgress.btnCancelClick(Sender: TObject);
resourcestring
SAbortMsg = 'Abort transferring data?';
begin
Terminated := MessageDlg(SAbortMsg, mtConfirmation, [mbYes, mbNo], 0) = mrYes;
end;
end.

BIN
components/flashfiler/sourcelaz/bde2ff/fmmain.dfm Normal file
View File

Binary file not shown.

830
components/flashfiler/sourcelaz/bde2ff/fmmain.pas Normal file
View File

@ -0,0 +1,830 @@
{*********************************************************}
{* Main file *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
{Rewritten !!.11}
unit fmmain;
interface
uses
Windows,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
DB,
DBTables,
StdCtrls,
ExtCtrls,
Buttons,
Menus,
ffclimex,
ffllbase,
fflldict,
ffllprot,
ffclintf,
dgimpdo,
ffdb,
ffdbbase,
ComCtrls;
type
TfrmMain = class(TForm)
tblSource: TTable;
btnTransfer: TBitBtn;
btnExit: TBitBtn;
imgCheck: TImage;
btnHelp: TBitBtn;
mnuMain: TMainMenu;
mnuOperations: TMenuItem;
mnuHelp: TMenuItem;
mnuHelpContents: TMenuItem;
mnuAbout: TMenuItem;
tblDest: TffTable;
dbDest: TffDatabase;
mnuExit: TMenuItem;
N1: TMenuItem;
mnuTransferActiveTable: TMenuItem;
pgTransfer: TPageControl;
tabSource: TTabSheet;
tabOptions: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
lstBDETables: TListBox;
lstBDEFields: TListBox;
tabTarget: TTabSheet;
Label3: TLabel;
Label5: TLabel;
edtFFTableName: TEdit;
lstFFTables: TListBox;
cmbBDEAliases: TComboBox;
cmbFFAliases: TComboBox;
grpStringHandling: TGroupBox;
chkClearEmptyStrings: TCheckBox;
chkEmptyStrings: TCheckBox;
chkOEMAnsi: TCheckBox;
chkUseANSIFields: TCheckBox;
chkUseZeroTerminatedStrings: TCheckBox;
grpMisc: TGroupBox;
chkSchemaOnly: TCheckBox;
chkUseSysToolsDates: TCheckBox;
chkUseSysToolsTimes: TCheckBox;
grpExistingData: TRadioGroup;
procedure btnTransferClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure lstBDEFieldsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure lstBDEFieldsDblClick(Sender: TObject);
procedure btnHelpClick(Sender: TObject);
procedure edtBDEAliasNameChange(Sender: TObject);
procedure edtBDEAliasNameExit(Sender: TObject);
procedure edtBDEAliasNameKeyPress(Sender: TObject; var Key: Char);
procedure edtBDETableNameChange(Sender: TObject);
procedure edtBDETableNameExit(Sender: TObject);
procedure edtBDETableNameKeyPress(Sender: TObject; var Key: Char);
procedure edtFFTableNameChange(Sender: TObject);
procedure edtFFTableNameExit(Sender: TObject);
procedure edtFFTableNameKeyPress(Sender: TObject; var Key: Char);
procedure lstFFTablesDblClick(Sender: TObject);
procedure mnuAboutClick(Sender: TObject);
procedure cmbBDEAliasesChange(Sender: TObject);
procedure lstBDETablesClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cmbFFAliasesChange(Sender: TObject);
procedure chkClearEmptyStringsClick(Sender: TObject);
procedure chkEmptyStringsClick(Sender: TObject);
protected
BDETablesLoaded: Boolean;
BDETableInited: Boolean;
FFTablesLoaded: Boolean;
FFTableInited: Boolean;
Aborted: Boolean;
IsSQLServer: Boolean;
procedure ConvertTable(const BDETableName, FFTableName : TffTableName);
procedure CreateNewTable(const BDETableName, FFTableName: TffTableName);
procedure InitBDETable;
function InitCommsEngine: Boolean;
procedure InitFFTable;
procedure LoadAliases;
procedure LoadBDETables;
procedure LoadFFTables;
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
uses
FFAbout;
const
FG_UNSELECTED = 0;
FG_SELECTED = 1;
FG_UNAVAILABLE = 2;
csSQLServer = 'SQL Server';
procedure TfrmMain.CreateNewTable(const BDETableName, FFTableName: TffTableName);
var
Dict: TffDataDictionary;
I: Integer;
IdxName: string;
FFType: TffFieldType;
FFSize: Longint;
FFDecPl: Integer;
FldArray: TffFieldList;
IHelpers: TffFieldIHList;
NFields: Integer;
procedure ParseFieldNames(aFieldNames: TffShStr);
var
DoFieldNums: Boolean;
FieldEntry: TffShStr;
FieldNo: Integer;
begin
DoFieldNums := False; {!!.03 - Start}
if aFieldNames[1] in ['0'..'9'] then begin
FieldNo := 2;
while True do begin
if aFieldNames[FieldNo] = ';' then begin
DoFieldNums := True;
Break;
end
else if aFieldNames[FieldNo] in ['0'..'9'] then
Inc(FieldNo)
else begin
DoFieldNums := False;
Break;
end;
end;
end; {!!.03 - End}
NFields := 0;
repeat
FFShStrSplit(aFieldNames, ';', FieldEntry, aFieldNames);
if DoFieldNums then
FldArray[NFields] := StrToInt(FieldEntry) - 1
else begin
FieldNo := Dict.GetFieldFromName(FieldEntry);
if FieldNo = -1 then
raise Exception.Create('Invalid field in index');
FldArray[NFields] := FieldNo;
end;
Inc(NFields);
if aFieldNames <> '' then {!!.02}
IHelpers[NFields] := ''; {!!.02}
until aFieldNames = '';
end;
function DetermineBlockSize: LongInt;
var
FFType: TffFieldType;
FFSize: Longint;
FFDecPl: Integer;
BlockSize: LongInt;
i: Integer;
begin
{ Build size from source table structure }
with tblSource do begin
{Management size}
BlockSize := 32 + 1;
{ Get the fields }
FieldDefs.Update;
if lstBDETables.SelCount > 1 then begin
for I := 0 to Pred(FieldDefs.Count) do begin
with FieldDefs[I] do begin
ConvertBDEDataType(DataType, Size, FFType, FFSize, FFDecPl);
BlockSize := BlockSize + FFSize;
end; { if }
end;
end
else begin
{ Calculate using only the fields selected in the fields list. }
with lstBDEFields do
for I := 0 to Items.Count - 1 do
if (LongInt(Items.Objects[I]) and FG_SELECTED) <> 0 then
with FieldDefs[I] do begin
ConvertBDEDataType(DataType, Size, FFType, FFSize, FFDecPl);
BlockSize := BlockSize + FFSize;
end; { if }
end; { if }
end; { with }
{ Determine the first multiple of 4096 larger then BlockSize }
Result := (BlockSize div 4096 + 1) * 4096;
end;
begin
Dict := TffDataDictionary.Create(DetermineBlockSize);
try
{ Initialize the FieldArray }
for I := 0 to pred(ffcl_MaxIndexFlds) do begin
FldArray[I] := 0;
IHelpers[I] := '';
end;
{ Build dictionary from source table structure }
with tblSource do begin
{ Point to the source table. }
TableName := BDETableName;
ReadOnly := True;
{ Get the fields }
FieldDefs.Update;
{ Obtain the field definitions. }
if lstBDETables.SelCount > 1 then begin
{ Convert all fields. }
for I := 0 to Pred(FieldDefs.Count) do begin
with FieldDefs[I] do begin
ConvertBDEDataType(DataType, Size, FFType, FFSize, FFDecPl);
Dict.AddField(Name,
'', { description }
FFType,
FFSize,
FFDecPl,
Required,
nil);
end; { with }
end; { for }
end
else begin
{ Convert only the fields selected in the fields list. }
with lstBDEFields do
for I := 0 to Items.Count - 1 do
if (LongInt(Items.Objects[I]) and FG_SELECTED) <> 0 then
with FieldDefs[I] do begin
ConvertBDEDataType(DataType, Size, FFType, FFSize, FFDecPl);
Dict.AddField(Name,
'', { description }
FFType,
FFSize,
FFDecPl,
Required,
nil);
end; { with }
end; { if }
{ Obtain the indices. }
IndexDefs.Update;
for I := 0 to IndexDefs.Count - 1 do begin
with IndexDefs[I] do {!!.10}
if not (ixExpression in Options) then begin {!!.10}
ParseFieldNames(Fields);
IdxName := Name;
if IdxName = '' then
if ixPrimary in Options then
IdxName := 'FF$PRIMARY'
else
IdxName := 'FF$INDEX' + IntToStr(I + 1);
Dict.AddIndex(IdxName, { index name }
'', { description }
0, { file no }
NFields, { field count }
FldArray, { field list }
IHelpers, { index helper list }
not (ixUnique in Options), { allow dups }
not (ixDescending in Options), { ascending }
ixCaseInsensitive in Options); { case insensitive }
end; { if } {!!.10}
end;
{ Create the actual table }
Check(dbDest.CreateTable(False, FFTableName, Dict))
end;
finally
Dict.Free;
end;
end;
procedure TfrmMain.InitBDETable;
var
I: Integer;
Flag: LongInt;
begin
if lstBDETables.SelCount > 1 then begin
lstBDEFields.Clear;
lstBDEFields.Items.Add('<All fields will be converted for each table>');
lstBDEFields.Enabled := False;
lstBDEFields.Color := clBtnFace;
end
else begin
lstBDEFields.Color := clWindow;
lstBDEFields.Enabled := True;
with tblSource do begin
DatabaseName := cmbBDEAliases.Text;
{ Find the selected table. }
for I := 0 to Pred(lstBDETables.Items.Count) do
if lstBDETables.Selected[I] then begin
TableName := lstBDETables.Items[I];
break;
end; { if }
FieldDefs.Update;
lstBDEFields.Clear;
for I := 0 to FieldDefs.Count - 1 do begin
Flag := FG_SELECTED;
lstBDEFields.Items.AddObject(FieldDefs[I].Name, Pointer(Flag));
end; { for }
end; { with }
end;
BDETableInited := True;
end;
function TfrmMain.InitCommsEngine: Boolean;
begin
cmbBDEAliases.Clear;
cmbFFAliases.Clear;
Result := True;
try
FFDB.Session.Open;
LoadAliases;
except
on E: Exception do begin
MessageDlg(E.Message, mtError, [mbOk], 0);
Result := False;
end;
end;
end;
procedure TfrmMain.InitFFTable;
begin
with tblDest do begin
if Active then Close;
TableName := edtFFTableName.Text;
end;
FFTableInited := True;
end;
procedure TfrmMain.LoadAliases;
var
Aliases: TStringList;
I: Integer;
begin
{ Segregate the FlashFiler and native BDE aliases }
Aliases := TStringList.Create;
try
DBTables.Session.GetAliasNames(Aliases);
with Aliases do begin
for I := 0 to Count - 1 do
cmbBDEAliases.Items.Add(Strings[I]);
cmbBDEAliases.ItemIndex := 0;
LoadBDETables;
end;
Aliases.Clear;
FFDB.Session.GetAliasNames(Aliases);
with Aliases do begin
for I := 0 to Count - 1 do
cmbFFAliases.Items.Add(Strings[I]);
cmbFFAliases.ItemIndex := -1;
end;
finally
Aliases.Free;
end;
end;
procedure TfrmMain.LoadBDETables;
begin
if cmbBDEAliases.Text <> '' then begin
try {!!.13}
DBTables.Session.GetTableNames(cmbBDEAliases.Text, '', True, False,
lstBDETables.Items);
except {!!.13}
{ ignore all bde exceptions } {!!.13}
end; {!!.13}
BDETablesLoaded := True;
end;
end;
procedure TfrmMain.LoadFFTables;
var
FFTables: TStringList;
I: Integer;
TableName: string;
begin
if cmbFFAliases.Text <> '' then begin
dbDest.Connected := False;
dbDest.AliasName := cmbFFAliases.Text;
dbDest.DatabaseName := 'FF2_' + cmbFFAliases.Text;
dbDest.Connected := True;
lstFFTables.Clear;
FFTables := TStringList.Create;
try
FFDB.Session.GetTableNames(cmbFFAliases.Text, '', True, False, FFTables);
with FFTables do
for I := 0 to Count - 1 do begin
TableName := Copy(Strings[I], 1, Pos('.', Strings[I]) - 1);
lstFFTables.Items.Add(TableName);
end;
finally
FFTables.Free;
end;
FFTablesLoaded := True;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
IsSQLServer := False;
if FileExists(ExtractFilePath(ParamStr(0)) + 'BDE2FF.HLP') then
Application.HelpFile := ExtractFilePath(ParamStr(0)) + 'BDE2FF.HLP'
else
Application.HelpFile := ExtractFilePath(ParamStr(0)) + '..\DOC\BDE2FF.HLP';
InitCommsEngine;
end;
procedure TfrmMain.lstBDEFieldsDblClick(Sender: TObject);
begin
with (Sender as TListBox) do
if (LongInt(Items.Objects[ItemIndex]) and FG_UNAVAILABLE) <> 0 then
MessageBeep(0)
else begin
Items.Objects[ItemIndex] := Pointer((LongInt(Items.Objects[ItemIndex]) + 1) mod 2);
Invalidate;
end;
end;
procedure TfrmMain.lstBDEFieldsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TListBox) do begin
with Canvas do begin
Font.Assign(Font);
if (odSelected) in State then begin
Font.Color := clWindowText;
Brush.Color := (Control as TListBox).Color;
end;
FillRect(Rect);
if (LongInt(Items.Objects[Index]) and FG_SELECTED) <> 0 then
with imgCheck.Picture.Bitmap do
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 4, Width, Height),
imgCheck.Picture.Bitmap, Bounds(0, 0, Width, Height),
TransparentColor);
if (LongInt(Items.Objects[Index]) and FG_UNAVAILABLE) <> 0 then
Font.Color := clRed;
{ Draw the item text }
TextOut(Rect.Left + imgCheck.Picture.Bitmap.Width + 4, Rect.Top, Items[Index]);
end;
end;
end;
procedure TfrmMain.ConvertTable(const BDETableName, FFTableName : TffTableName);
var
I: Integer;
Msg,
BDETableNameFinal : string;
NewTable,
MultTables : Boolean;
NumTransferred: LongInt;
SourceFields: TStringList;
ZMsg: array[0..255] of Char;
begin
MultTables := (lstBDETables.SelCount > 1);
{ Init vars }
Aborted := False;
NewTable := False;
NumTransferred := 0;
tblDest.TableName := FFTableName;
{ If the user selected a table in a SQL Server database then strip the
leading database name from the table name. }
BDETableNameFinal := BDETableName;
if IsSQLServer and (Pos('.', BDETableNameFinal) > 0) then begin
I := 1;
while BDETableNameFinal[I] <> '.' do
inc(I);
Delete(BDETableNameFinal, 1, I);
end; { if }
tblSource.TableName := BDETableNameFinal;
tblSource.FieldDefs.Update;
try
{ Check for schema only import }
if chkSchemaOnly.Checked then begin
if (not tblDest.Exists) then begin
Msg := 'Create new table ' + FFTableName + ' from schema only?';
NewTable := True;
end
else
Msg := 'Replace table ' + FFTableName + ' from schema only?';
{ If multiple tables being converted or user approves, recreate the
table. }
if MultTables or
(MessageDlg(Msg, mtConfirmation, [mbYes, mbNo], 0) = mrYes) then begin
if not NewTable then
tblDest.DeleteTable;
CreateNewTable(BDETableName, FFTableName);
end
else
Aborted := True;
end
else begin
{ Data only or data & schema. }
case grpExistingData.ItemIndex of
0 : { Keep existing structure & data }
if not tblDest.Exists then begin
if MultTables or
(MessageDlg('Create new table ' + edtFFTableName.Text + '?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes) then begin
CreateNewTable(BDETableName, FFTableName);
NewTable := True;
end; { if }
end;
1 : { Keep existing structure, replace data }
if tblDest.Exists then
{ Empty the table. }
tblDest.EmptyTable
else begin
CreateNewTable(BDETableName, FFTableName);
NewTable := True;
end;
2 : { Replace structure & data }
if MultTables or
(not tblDest.Exists) or
(MessageDlg('Replace table ' + edtFFTableName.Text + '?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes) then begin
if tblDest.Exists then
tblDest.DeleteTable;
CreateNewTable(BDETableName, FFTableName);
NewTable := True;
end
else
Exit;
end; { case }
{ Begin the transfer process }
Self.Enabled := False;
try
try
SourceFields := TStringList.Create;
try
{ If more than one table has been selected then convert all
fields otherwise convert only those selected in the fields list. }
if (lstBDETables.SelCount > 1) then begin
for I := 0 to Pred(tblSource.FieldDefs.Count) do
SourceFields.Add(ANSIUppercase(tblSource.fieldDefs[I].Name));
end
else begin
with lstBDEFields do
for I := 0 to Items.Count - 1 do
if (LongInt(Items.Objects[I]) and FG_SELECTED) <> 0 then
SourceFields.Add(ANSIUppercase(Items[I]));
end; { if }
Aborted := not DoImport(tblSource, SourceFields,
tblDest, 100, NumTransferred);
finally
SourceFields.Free;
end;
except
Aborted := True;
raise;
end;
finally
{ If we've aborted and we created a new table, get rid of it }
if Aborted then begin
if NewTable then begin
tblDest.DeleteTable;
NewTable := False;
end;
end;
Application.ProcessMessages;
Self.Enabled := True;
end;
end;
finally
end;
if not Aborted then begin
if NewTable then LoadFFTables;
MessageBeep(0);
StrPCopy(ZMsg, 'Transfer Completed. ' + #13#13 +
Format('%d records transferred.', [NumTransferred]));
if lstBDETables.SelCount = 1 then
Application.MessageBox(ZMsg, 'BDE Transfer to FlashFiler',
MB_ICONINFORMATION or MB_OK);
end;
if not Aborted then ModalResult := mrOK;
end;
procedure TfrmMain.btnTransferClick(Sender: TObject);
var
FFTableName : TffTableName;
Inx : Integer;
begin
{ Check Requirements }
if (lstBDETables.SelCount = 0) then begin
ShowMessage('Please select one or more BDE tables for conversion.');
Exit;
end;
if cmbFFAliases.ItemIndex = -1 then begin
ShowMessage('Please specify a target FlashFiler database.');
Exit;
end;
if (lstBDETables.SelCount = 1) and (edtFFTableName.Text = '') then begin
ShowMessage('Please specify a destination FlashFiler table.');
Exit;
end;
if tblDest.Active then
tblDest.Close;
tblDest.DatabaseName := 'FF2_' + cmbFFAliases.Text;
for Inx := 0 to Pred(lstBDETables.Items.Count) do begin
if lstBDETables.Selected[Inx] then begin
if lstBDETables.SelCount > 1 then
FFTableName := ChangeFileExt(lstBDETables.Items[Inx], '')
else
FFTableName := edtFFTableName.Text;
ConvertTable(lstBDETables.Items[Inx], FFTableName)
end;
end; { for }
end;
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.btnHelpClick(Sender: TObject);
begin
Application.HelpCommand(HELP_CONTENTS, 0);
end;
procedure TfrmMain.edtBDEAliasNameChange(Sender: TObject);
begin
BDETablesLoaded := False;
BDETableInited := False;
end;
procedure TfrmMain.edtBDEAliasNameExit(Sender: TObject);
begin
if not BDETablesLoaded then LoadBDETables;
end;
procedure TfrmMain.edtBDEAliasNameKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then begin
if not BDETablesLoaded then
LoadBDETables;
Key := #0;
end;
end;
procedure TfrmMain.edtBDETableNameChange(Sender: TObject);
begin
BDETableInited := False;
end;
procedure TfrmMain.edtBDETableNameExit(Sender: TObject);
begin
if not BDETableInited then InitBDETable;
end;
procedure TfrmMain.edtBDETableNameKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then begin
if not BDETableInited then InitBDETable;
Key := #0;
end;
end;
procedure TfrmMain.edtFFTableNameChange(Sender: TObject);
begin
FFTableInited := False;
end;
procedure TfrmMain.edtFFTableNameExit(Sender: TObject);
begin
if not FFTableInited then InitFFTable;
end;
procedure TfrmMain.edtFFTableNameKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then begin
if not FFTableInited then InitFFTable;
Key := #0;
end;
end;
procedure TfrmMain.lstFFTablesDblClick(Sender: TObject);
begin
with lstFFTables do
if ItemIndex <> -1 then begin
edtFFTableName.Text := Items[ItemIndex];
InitFFTable;
end;
end;
procedure TfrmMain.mnuAboutClick(Sender: TObject);
var
AboutBox: TFFAboutBox;
begin
AboutBox := TFFAboutBox.Create(Application);
try
AboutBox.Caption := 'About FlashFiler Utility';
AboutBox.ProgramName.Caption := 'FlashFiler BDE2FF Converter';
AboutBox.ShowModal;
finally
AboutBox.Free;
end;
end;
procedure TfrmMain.cmbBDEAliasesChange(Sender: TObject);
begin
IsSQLServer := (DBTables.Session.GetAliasDriverName(cmbBDEAliases.Text) = csSQLServer);
LoadBDETables;
end;
procedure TfrmMain.lstBDETablesClick(Sender: TObject);
var
Inx : Integer;
begin
InitBDETable;
InitFFTable;
if (lstBDETables.SelCount = 1) then begin
for Inx := 0 to Pred(lstBDETables.Items.Count) do
if lstBDETables.Selected[Inx] then begin
edtFFTableName.Text := ChangeFileExt(lstBDETables.Items[Inx], '');
Break;
end;
end;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
pgTransfer.ActivePage := tabSource;
end;
procedure TfrmMain.cmbFFAliasesChange(Sender: TObject);
begin
FFTablesLoaded := False;
FFTableInited := False;
LoadFFTables;
end;
procedure TfrmMain.chkClearEmptyStringsClick(Sender: TObject);
begin
chkEmptyStrings.Checked := not chkClearEmptyStrings.Checked;
end;
procedure TfrmMain.chkEmptyStringsClick(Sender: TObject);
begin
chkClearEmptyStrings.Checked := not chkEmptyStrings.Checked;
end;
end.

48
components/flashfiler/sourcelaz/beta/beta.dpr Normal file
View File

@ -0,0 +1,48 @@
{*********************************************************}
{* Project source file *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
program BETA;
uses
{$IFDEF USETeDEBUG}
TeDebug,
{$ENDIF}
Forms,
fmMain in 'fmMain.pas' {frmMain};
{$R *.RES}
begin
Application.Initialize;
Application.HelpFile := 'BETA.HLP';
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.

61
components/flashfiler/sourcelaz/beta/beta.rc Normal file
View File

@ -0,0 +1,61 @@
/*********************************************************
* Main program icon resource *
*********************************************************/
/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */
#define VERSIONINFO_1 1
VERSIONINFO_1 VERSIONINFO
FILEVERSION 2, 1, 3, 0
PRODUCTVERSION 2, 1, 3, 0
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
{
BLOCK "StringFileInfo"
{
BLOCK "040904E4"
{
VALUE "CompanyName", "TurboPower Software Company\000\000"
VALUE "FileDescription", "FlashFiler BETA\000"
VALUE "FileVersion", "2.1.3.0\000"
VALUE "InternalName", "BETA\000"
VALUE "LegalCopyright", "Copyright (c) TurboPower Software Co. 1996-2002\000\000"
VALUE "OriginalFilename", "BETA.EXE\000"
VALUE "ProductName", "FlashFiler (Delphi Edition)\000"
VALUE "ProductVersion", "2.1.3.0\000"
}
}
BLOCK "VarFileInfo"
{
VALUE "Translation", 0x409, 1252
}
}

BIN
components/flashfiler/sourcelaz/beta/beta.res Normal file
View File

Binary file not shown.

BIN
components/flashfiler/sourcelaz/beta/fmmain.dfm Normal file
View File

Binary file not shown.

434
components/flashfiler/sourcelaz/beta/fmmain.pas Normal file
View File

@ -0,0 +1,434 @@
{*********************************************************}
{* Main file *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
unit fmMain;
interface
uses
Windows,
BDE,
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DB, DBTables, StdCtrls, FileCtrl, ExtCtrls, Buttons, IniFiles;
type
TfrmMain = class(TForm)
tblSource: TTable;
tblDest: TTable;
batBatchMove: TBatchMove;
grpSource: TGroupBox;
Label1: TLabel;
Label2: TLabel;
lstAliases: TListBox;
edtAliasName: TEdit;
edtTableName: TEdit;
lstTables: TListBox;
grpDestination: TGroupBox;
Label3: TLabel;
Label6: TLabel;
lblDirectory: TLabel;
edtOutputFilename: TEdit;
lstFields: TListBox;
Label4: TLabel;
lstFiles: TFileListBox;
lstDirectories: TDirectoryListBox;
cboFilter: TFilterComboBox;
cboDrives: TDriveComboBox;
Label5: TLabel;
Label7: TLabel;
imgCheck: TImage;
chkSchemaOnly: TCheckBox;
Button1: TButton;
btnClose: TButton;
btnHelp: TButton;
procedure btnExportClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure lstAliasesDblClick(Sender: TObject);
procedure lstTablesDblClick(Sender: TObject);
procedure lstFieldsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure lstFieldsDblClick(Sender: TObject);
procedure btnHelpClick(Sender: TObject);
procedure edtAliasNameChange(Sender: TObject);
procedure edtAliasNameExit(Sender: TObject);
procedure edtAliasNameKeyPress(Sender: TObject; var Key: Char);
procedure edtTableNameChange(Sender: TObject);
procedure edtTableNameExit(Sender: TObject);
procedure edtTableNameKeyPress(Sender: TObject; var Key: Char);
procedure chkSchemaOnlyClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
private
public
TablesLoaded: Boolean;
TableInited: Boolean;
procedure AdjustSchemaFile(aTable: TTable; aFilename: TFilename);
procedure InitTable;
procedure LoadTables;
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
const
FG_UNSELECTED = 0;
FG_SELECTED = 1;
FG_UNAVAILABLE = 2;
BlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary];
procedure TfrmMain.AdjustSchemaFile(aTable: TTable; aFilename: TFilename);
var
F: Integer;
FldNo: Integer;
I: Integer;
SchemaFile: TIniFile;
SectionName: string;
Ext: string[10];
Entry: string;
DateFormat: FMTDate;
TimeFormat: FMTTime;
EntryID,
Mask,
DateMask,
TimeMask: string[40];
begin
{ Extract the date format from the BDE }
DbiGetDateFormat(DateFormat);
with DateFormat do begin
case iDateMode of
0: DateMask := 'M' + szDateSeparator + 'D' + szDateSeparator + 'Y';
1: DateMask := 'D' + szDateSeparator + 'M' + szDateSeparator + 'Y';
2: DateMask := 'Y' + szDateSeparator + 'M' + szDateSeparator + 'D';
end;
end;
{ Extract the time format from the BDE }
DbiGetTimeFormat(TimeFormat);
with TimeFormat do begin
TimeMask := 'h' + cTimeSeparator + 'm';
if bSeconds then
TimeMask := TimeMask + cTimeSeparator + 's';
if bTwelveHour then
TimeMask := TimeMask + ' t';
end;
SchemaFile := TIniFile.Create(aFilename);
try
SectionName := ExtractFileName(aFilename);
Ext := ExtractFileExt(SectionName);
if Ext <> '' then
Delete(SectionName, Pos(Ext, SectionName), Length(Ext));
{ Change the filetype }
SchemaFile.WriteString(SectionName, 'FILETYPE', 'ASCII');
{ Loop through fields, making adjustments }
FldNo := 0;
with aTable.FieldDefs do
for F := 0 to Count - 1 do
if (LongInt(lstFields.Items.Objects[F]) and FG_SELECTED) <> 0 then
with Items[F] do begin
Inc(FldNo);
{ Get the current schema file entry for this field }
EntryID := 'Field' + IntToStr(FldNo);
Entry := SchemaFile.ReadString(SectionName, EntryID, '');
{ Add masks for date/time fields }
case Datatype of
ftDate, ftTime, ftDateTime:
begin
Mask := '';
case DataType of
ftDate: Mask := DateMask;
ftTime: Mask := TimeMask;
ftDateTime: Mask := DateMask + ' ' + TimeMask;
end;
if Mask <> '' then begin
{ Append a local mask to it }
if Pos(',', Mask) <> 0 then Mask := '"' + Mask + '"';
Entry := Entry + ',' + Mask;
{ Rewrite the modified entry back to the schema file }
SchemaFile.WriteString(SectionName, EntryID, Entry);
end;
end;
ftInteger:
begin
I := Pos('LONG INTEGER', ANSIUppercase(Entry));
System.Delete(Entry, I, 12);
System.Insert('LongInt', Entry, I);
SchemaFile.WriteString(SectionName, EntryID, Entry);
end;
ftAutoInc:
begin
I := Pos('LONG INTEGER', ANSIUppercase(Entry));
System.Delete(Entry, I, 12);
System.Insert('AutoInc', Entry, I);
SchemaFile.WriteString(SectionName, EntryID, Entry);
end;
end;
end;
finally
SchemaFile.Free;
end;
end;
procedure TfrmMain.InitTable;
var
I: Integer;
Flag: LongInt;
begin
with tblSource do begin
DatabaseName := edtAliasName.Text;
TableName := edtTableName.Text;
FieldDefs.Update;
lstFields.Clear;
for I := 0 to FieldDefs.Count - 1 do begin
Flag := FG_SELECTED;
if (FieldDefs[I].DataType in BlobTypes) then
Flag := FG_UNAVAILABLE;
lstFields.Items.AddObject(FieldDefs[I].Name, Pointer(Flag));
end;
end;
edtOutputFilename.Text := ChangeFileExt(ExtractFileName(edtTableName.Text), '.ASC');
TableInited := True;
end;
procedure TfrmMain.LoadTables;
begin
if edtAliasName.Text <> '' then begin
Session.GetTableNames(edtAliasName.Text, '', True, False, lstTables.Items);
TablesLoaded:= True;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Application.HelpFile := ExtractFilePath(ParamStr(0)) + 'BETA.HLP';
Session.GetAliasNames(lstAliases.Items);
end;
procedure TfrmMain.lstAliasesDblClick(Sender: TObject);
begin
edtTableName.Text := '';
with lstAliases do
if ItemIndex <> -1 then begin
edtAliasName.Text := Items[ItemIndex];
LoadTables;
end;
end;
procedure TfrmMain.lstTablesDblClick(Sender: TObject);
begin
with lstTables do
if ItemIndex <> - 1 then begin
edtTableName.Text := Items[ItemIndex];
InitTable;
end;
end;
procedure TfrmMain.lstFieldsDblClick(Sender: TObject);
begin
with lstFields do
if (LongInt(Items.Objects[ItemIndex]) and FG_UNAVAILABLE) <> 0 then
MessageBeep(0)
else begin
Items.Objects[ItemIndex] := Pointer((LongInt(Items.Objects[ItemIndex]) + 1) mod 2);
Invalidate;
end;
end;
procedure TfrmMain.lstFieldsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TListBox) do begin
with Canvas do begin
Font.Assign(Font);
if (odSelected) in State then begin
Font.Color := clWindowText;
Brush.Color := (Control as TListBox).Color;
end;
FillRect(Rect);
if (LongInt(Items.Objects[Index]) and FG_SELECTED) <> 0 then
with imgCheck.Picture.Bitmap do
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 4, Width, Height),
imgCheck.Picture.Bitmap, Bounds(0, 0, Width, Height),
TransparentColor);
if (LongInt(Items.Objects[Index]) and FG_UNAVAILABLE) <> 0 then
Font.Color := clRed;
{ Draw the item text }
TextOut(Rect.Left + imgCheck.Picture.Bitmap.Width + 4, Rect.Top, Items[Index]);
end;
end;
end;
procedure TfrmMain.btnExportClick(Sender: TObject);
var
I: Integer;
ValidFields: TStringList;
SchemaFilePath: string;
DestPath: string;
DestName: string;
CheckFile: string;
begin
if (Pos('*', edtOutputFilename.Text) <> 0) or
(Pos('?', edtOutputFilename.Text) <> 0) or
(edtOutputFilename.Text = '') then
raise Exception.Create('Invalid output filename');
DestPath := ExtractFilePath(edtOutputFilename.Text);
if DestPath = '' then
DestPath := lblDirectory.Caption;
if Copy(DestPath, Length(DestPath), 1) <> '\' then
DestPath := DestPath + '\';
if chkSchemaOnly.Checked then begin
batBatchMove.RecordCount := 1;
DestName := ChangeFileExt(ExtractFilename(edtOutputFilename.Text), '.$$$');
end
else
DestName := ExtractFilename(edtOutputFilename.Text);
CheckFile := DestPath + ExtractFilename(edtOutputFilename.Text);
if FileExists(CheckFile) then
if MessageDlg('Replace ' + CheckFile + '?', mtWarning, [mbYes, mbNo], 0) <> mrYes then
Exit;
batBatchMove.Mappings.Clear;
with tblSource do begin
DatabaseName := edtAliasName.Text;
TableName := edtTableName.Text;
{ Build the BatchMove mapping for the valid fields }
ValidFields := TStringList.Create;
try
with lstFields do
for I := 0 to Items.Count - 1 do
if (LongInt(Items.Objects[I]) and FG_SELECTED) <> 0 then
ValidFields.Add(Items[I]);
batBatchMove.Mappings.Assign(ValidFields);
finally
ValidFields.Free;
end;
end;
with tblDest do begin
DatabaseName := DestPath;
TableName := DestName;
SchemaFilePath := ChangeFileExt(DatabaseName + TableName, '.SCH');
DeleteFile(SchemaFilePath);
end;
Screen.Cursor := crHourglass;
try
batBatchMove.Execute;
AdjustSchemaFile(tblSource, SchemaFilePath);
finally
Screen.Cursor := crDefault;
if chkSchemaOnly.Checked then
DeleteFile(ChangeFileExt(SchemaFilePath, '.$$$'));
end;
MessageBeep(0);
Application.MessageBox('Export Completed', 'BDE Export', MB_OK);
end;
procedure TfrmMain.btnHelpClick(Sender: TObject);
begin
Application.HelpCommand(HELP_FINDER, 0);
end;
procedure TfrmMain.edtAliasNameChange(Sender: TObject);
begin
TablesLoaded := False;
TableInited := False;
end;
procedure TfrmMain.edtAliasNameExit(Sender: TObject);
begin
if not TablesLoaded then LoadTables;
end;
procedure TfrmMain.edtAliasNameKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then begin
if not TablesLoaded then
LoadTables;
Key := #0;
end;
end;
procedure TfrmMain.edtTableNameChange(Sender: TObject);
begin
TableInited := False;
end;
procedure TfrmMain.edtTableNameExit(Sender: TObject);
begin
if not TableInited then InitTable;
end;
procedure TfrmMain.edtTableNameKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then begin
if not TableInited then InitTable;
Key := #0;
end;
end;
procedure TfrmMain.chkSchemaOnlyClick(Sender: TObject);
begin
if chkSchemaOnly.Checked and (edtOutputFilename.Text <> '') then
edtOutputFilename.Text := ChangeFileExt(edtOutputFilename.Text, '.SCH');
end;
procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
Close;
end;
end.

898
components/flashfiler/sourcelaz/cocobase.pas Normal file
View File

@ -0,0 +1,898 @@
unit CocoBase;
{Base components for Coco/R for Delphi grammars for use with version 1.1}
interface
{$I FFDEFINE.INC}
uses
Classes, SysUtils;
const
setsize = 16; { sets are stored in 16 bits }
{ Standard Error Types }
etSyntax = 0;
etSymantic = 1;
chCR = #13;
chLF = #10;
chEOL = chCR + chLF; { End of line characters for Microsoft Windows }
chLineSeparator = chCR;
type
ECocoBookmark = class(Exception);
TCocoStatusType = (cstInvalid, cstBeginParse, cstEndParse, cstLineNum, cstString);
TCocoError = class(TObject)
private
FErrorCode : integer;
FCol : integer;
FLine : integer;
FData : string;
FErrorType : integer;
public
property ErrorType : integer read FErrorType write FErrorType;
property ErrorCode : integer read FErrorCode write FErrorCode;
property Line : integer read FLine write FLine;
property Col : integer read FCol write FCol;
property Data : string read FData write FData;
end; {TCocoError}
TCommentItem = class(TObject)
private
fComment: string;
fLine: integer;
fColumn: integer;
public
property Comment : string read fComment write fComment;
property Line : integer read fLine write fLine;
property Column : integer read fColumn write fColumn;
end; {TCommentItem}
TCommentList = class(TObject)
private
fList : TList;
function FixComment(const S : string) : string;
function GetComments(Idx: integer): string;
procedure SetComments(Idx: integer; const Value: string);
function GetCount: integer;
function GetText: string;
function GetColumn(Idx: integer): integer;
function GetLine(Idx: integer): integer;
procedure SetColumn(Idx: integer; const Value: integer);
procedure SetLine(Idx: integer; const Value: integer);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Add(const S : string; const aLine : integer; const aColumn : integer);
property Comments[Idx : integer] : string read GetComments write SetComments; default;
property Line[Idx : integer] : integer read GetLine write SetLine;
property Column[Idx : integer] : integer read GetColumn write SetColumn;
property Count : integer read GetCount;
property Text : string read GetText;
end; {TCommentList}
TSymbolPosition = class(TObject)
private
fLine : integer;
fCol : integer;
fLen : integer;
fPos : integer;
public
procedure Clear;
procedure Assign(Source : TSymbolPosition);
property Line : integer read fLine write fLine; {line of symbol}
property Col : integer read fCol write fCol; {column of symbol}
property Len : integer read fLen write fLen; {length of symbol}
property Pos : integer read fPos write fPos; {file position of symbol}
end; {TSymbolPosition}
TGenListType = (glNever, glAlways, glOnError);
TBitSet = set of 0..15;
PStartTable = ^TStartTable;
TStartTable = array[0..255] of integer;
TCharSet = set of char;
TAfterGenListEvent = procedure(Sender : TObject;
var PrintErrorCount : boolean) of object;
TAfterGrammarGetEvent = procedure(Sender : TObject;
var CurrentInputSymbol : integer) of object;
TCommentEvent = procedure(Sender : TObject; CommentList : TCommentList) of object;
TCustomErrorEvent = function(Sender : TObject; const ErrorCode : longint;
const Data : string) : string of object;
TErrorEvent = procedure(Sender : TObject; Error : TCocoError) of object;
TErrorProc = procedure(ErrorCode : integer; Symbol : TSymbolPosition;
Data : string; ErrorType : integer) of object;
TFailureEvent = procedure(Sender : TObject; NumErrors : integer) of object;
TGetCH = function(pos : longint) : char of object;
TStatusUpdateProc = procedure(Sender : TObject;
const StatusType : TCocoStatusType;
const Status : string;
const LineNum : integer) of object;
TCocoRScanner = class(TObject)
private
FbpCurrToken : integer; {position of current token)}
FBufferPosition : integer; {current position in buf }
FContextLen : integer; {length of appendix (CONTEXT phrase)}
FCurrentCh : TGetCH; {procedural variable to get current input character}
FCurrentSymbol : TSymbolPosition; {position of the current symbol in the source stream}
FCurrInputCh : char; {current input character}
FCurrLine : integer; {current input line (may be higher than line)}
FLastInputCh : char; {the last input character that was read}
FNextSymbol : TSymbolPosition; {position of the next symbol in the source stream}
FNumEOLInComment : integer; {number of _EOLs in a comment}
FOnStatusUpdate : TStatusUpdateProc;
FScannerError : TErrorProc;
FSourceLen : integer; {source file size}
FSrcStream : TMemoryStream; {source memory stream}
FStartOfLine : integer;
function GetNStr(Symbol : TSymbolPosition; ChProc : TGetCh) : string;
function ExtractBookmarkChar(var aBookmark: string): char;
protected
FStartState : TStartTable; {start state for every character}
function Bookmark : string; virtual;
procedure GotoBookmark(aBookmark : string); virtual;
function CapChAt(pos : longint) : char;
procedure Get(var sym : integer); virtual; abstract;
procedure NextCh; virtual; abstract;
function GetStartState : PStartTable;
procedure SetStartState(aStartTable : PStartTable);
property bpCurrToken : integer read fbpCurrToken write fbpCurrToken;
property BufferPosition : integer read fBufferPosition write fBufferPosition;
property ContextLen : integer read fContextLen write fContextLen;
property CurrentCh : TGetCh read fCurrentCh write fCurrentCh;
property CurrentSymbol : TSymbolPosition read fCurrentSymbol write fCurrentSymbol;
property CurrInputCh : char read fCurrInputCh write fCurrInputCh;
property CurrLine : integer read fCurrLine write fCurrLine;
property LastInputCh : char read fLastInputCh write fLastInputCh;
property NextSymbol : TSymbolPosition read fNextSymbol write fNextSymbol;
property NumEOLInComment : integer read fNumEOLInComment write fNumEOLInComment;
property OnStatusUpdate : TStatusUpdateProc read FOnStatusUpdate write FOnStatusUpdate;
property ScannerError : TErrorProc read FScannerError write FScannerError;
property SourceLen : integer read fSourceLen write fSourceLen;
property SrcStream : TMemoryStream read fSrcStream write fSrcStream;
property StartOfLine : integer read fStartOfLine write fStartOfLine;
property StartState : PStartTable read GetStartState write SetStartState;
public
constructor Create;
destructor Destroy; override;
function CharAt(pos : longint) : char;
function GetName(Symbol : TSymbolPosition) : string; // Retrieves name of symbol of length len at position pos in source file
function GetString(Symbol : TSymbolPosition) : string; // Retrieves exact string of max length len from position pos in source file
procedure _Reset;
end; {TCocoRScanner}
TCocoRGrammar = class(TComponent)
private
fAfterGet: TAfterGrammarGetEvent;
FAfterGenList : TAfterGenListEvent;
FAfterParse : TNotifyEvent;
FBeforeGenList : TNotifyEvent;
FBeforeParse : TNotifyEvent;
fClearSourceStream : boolean;
FErrDist : integer; // number of symbols recognized since last error
FErrorList : TList;
fGenListWhen : TGenListType;
FListStream : TMemoryStream;
FOnCustomError : TCustomErrorEvent;
FOnError : TErrorEvent;
FOnFailure : TFailureEvent;
FOnStatusUpdate : TStatusUpdateProc;
FOnSuccess : TNotifyEvent;
FScanner : TCocoRScanner;
FSourceFileName : string;
fExtra : integer;
function GetSourceStream : TMemoryStream;
function GetSuccessful : boolean;
procedure SetOnStatusUpdate(const Value : TStatusUpdateProc);
procedure SetSourceStream(const Value : TMemoryStream);
function GetLineCount: integer;
function GetCharacterCount: integer;
protected
fCurrentInputSymbol : integer; // current input symbol
function Bookmark : string; virtual;
procedure GotoBookmark(aBookmark : string); virtual;
procedure ClearErrors;
function ErrorStr(const ErrorCode : integer; const Data : string) : string; virtual; abstract;
procedure Expect(n : integer);
procedure GenerateListing;
procedure Get; virtual; abstract;
procedure PrintErr(line : string; ErrorCode, col : integer;
Data : string);
procedure StoreError(nr : integer; Symbol : TSymbolPosition;
Data : string; ErrorType : integer);
procedure DoAfterParse; virtual;
procedure DoBeforeParse; virtual;
property ClearSourceStream : boolean read fClearSourceStream write fClearSourceStream default true;
property CurrentInputSymbol : integer read fCurrentInputSymbol write fCurrentInputSymbol;
property ErrDist : integer read fErrDist write fErrDist; // number of symbols recognized since last error
property ErrorList : TList read FErrorList write FErrorList;
property Extra : integer read fExtra write fExtra;
property GenListWhen : TGenListType read fGenListWhen write fGenListWhen default glOnError;
property ListStream : TMemoryStream read FListStream write FListStream;
property SourceFileName : string read FSourceFileName write FSourceFileName;
property SourceStream : TMemoryStream read GetSourceStream write SetSourceStream;
property Successful : boolean read GetSuccessful;
{Events}
property AfterParse : TNotifyEvent read fAfterParse write fAfterParse;
property AfterGenList : TAfterGenListEvent read fAfterGenList write fAfterGenList;
property AfterGet : TAfterGrammarGetEvent read fAfterGet write fAfterGet;
property BeforeGenList : TNotifyEvent read fBeforeGenList write fBeforeGenList;
property BeforeParse : TNotifyEvent read fBeforeParse write fBeforeParse;
property OnCustomError : TCustomErrorEvent read FOnCustomError write FOnCustomError;
property OnError : TErrorEvent read fOnError write fOnError;
property OnFailure : TFailureEvent read FOnFailure write FOnFailure;
property OnStatusUpdate : TStatusUpdateProc read FOnStatusUpdate write SetOnStatusUpdate;
property OnSuccess : TNotifyEvent read FOnSuccess write FOnSuccess;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure GetLine(var pos : Integer; var line : string;
var eof : boolean);
function LexName : string;
function LexString : string;
function LookAheadName : string;
function LookAheadString : string;
procedure _StreamLine(s : string);
procedure _StreamLn(s : string);
procedure SemError(const errNo : integer; const Data : string);
procedure SynError(const errNo : integer);
property Scanner : TCocoRScanner read fScanner write fScanner;
property LineCount : integer read GetLineCount;
property CharacterCount : integer read GetCharacterCount;
end; {TCocoRGrammar}
const
_EF = #0;
_TAB = #09;
_CR = #13;
_LF = #10;
_EL = _CR;
_EOF = #26; {MS-DOS eof}
LineEnds : TCharSet = [_CR, _LF, _EF];
{ not only for errors but also for not finished states of scanner analysis }
minErrDist = 2; { minimal distance (good tokens) between two errors }
function PadL(S : string; ch : char; L : integer) : string;
function StrTok(
var Text : string;
const ch : char) : string;
implementation
const
INVALID_CHAR = 'Invalid Coco/R for Delphi bookmark character';
INVALID_INTEGER = 'Invalid Coco/R for Delphi bookmark integer';
BOOKMARK_STR_SEPARATOR = ' ';
function PadL(S : string; ch : char; L : integer) : string;
var
i : integer;
begin
for i := 1 to L - (Length(s)) do
s := ch + s;
Result := s;
end; {PadL}
function StrTok(
var Text : string;
const ch : char) : string;
var
apos : integer;
begin
apos := Pos(ch, Text);
if (apos > 0) then
begin
Result := Copy(Text, 1, apos - 1);
Delete(Text, 1, apos);
end
else
begin
Result := Text;
Text := '';
end;
end; {StrTok}
{ TSymbolPosition }
procedure TSymbolPosition.Assign(Source: TSymbolPosition);
begin
fLine := Source.fLine;
fCol := Source.fCol;
fLen := Source.fLen;
fPos := Source.fPos;
end; {Assign}
procedure TSymbolPosition.Clear;
begin
fLen := 0;
fPos := 0;
fLine := 0;
fCol := 0;
end; { Clear }
{ TCocoRScanner }
function TCocoRScanner.Bookmark: string;
begin
Result := IntToStr(bpCurrToken) + BOOKMARK_STR_SEPARATOR
+ IntToStr(BufferPosition) + BOOKMARK_STR_SEPARATOR
+ IntToStr(ContextLen) + BOOKMARK_STR_SEPARATOR
+ IntToStr(CurrLine) + BOOKMARK_STR_SEPARATOR
+ IntToStr(NumEOLInComment) + BOOKMARK_STR_SEPARATOR
+ IntToStr(StartOfLine) + BOOKMARK_STR_SEPARATOR
+ IntToStr(CurrentSymbol.Line) + BOOKMARK_STR_SEPARATOR
+ IntToStr(CurrentSymbol.Col) + BOOKMARK_STR_SEPARATOR
+ IntToStr(CurrentSymbol.Len) + BOOKMARK_STR_SEPARATOR
+ IntToStr(CurrentSymbol.Pos) + BOOKMARK_STR_SEPARATOR
+ IntToStr(NextSymbol.Line) + BOOKMARK_STR_SEPARATOR
+ IntToStr(NextSymbol.Col) + BOOKMARK_STR_SEPARATOR
+ IntToStr(NextSymbol.Len) + BOOKMARK_STR_SEPARATOR
+ IntToStr(NextSymbol.Pos) + BOOKMARK_STR_SEPARATOR
+ CurrInputCh
+ LastInputCh
end; {Bookmark}
function TCocoRScanner.ExtractBookmarkChar(var aBookmark : string) : char;
begin
if length(aBookmark) > 0 then
Result := aBookmark[1]
else
Raise ECocoBookmark.Create(INVALID_CHAR);
end; {ExtractBookmarkChar}
procedure TCocoRScanner.GotoBookmark(aBookmark: string);
var
BookmarkToken : string;
begin
try
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
bpCurrToken := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
BufferPosition := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
ContextLen := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
CurrLine := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
NumEOLInComment := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
StartOfLine := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
CurrentSymbol.Line := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
CurrentSymbol.Col := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
CurrentSymbol.Len := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
CurrentSymbol.Pos := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
NextSymbol.Line := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
NextSymbol.Col := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
NextSymbol.Len := StrToInt(BookmarkToken);
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
NextSymbol.Pos := StrToInt(BookmarkToken);
CurrInputCh := ExtractBookmarkChar(aBookmark);
LastInputCh := ExtractBookmarkChar(aBookmark);
except
on EConvertError do
Raise ECocoBookmark.Create(INVALID_INTEGER);
else
Raise;
end;
end; {GotoBookmark}
constructor TCocoRScanner.Create;
begin
inherited;
fSrcStream := TMemoryStream.Create;
CurrentSymbol := TSymbolPosition.Create;
NextSymbol := TSymbolPosition.Create;
end; {Create}
destructor TCocoRScanner.Destroy;
begin
fSrcStream.Free;
fSrcStream := NIL;
CurrentSymbol.Free;
CurrentSymbol := NIL;
NextSymbol.Free;
NextSymbol := NIL;
inherited;
end; {Destroy}
function TCocoRScanner.CapChAt(pos : longint) : char;
begin
Result := UpCase(CharAt(pos));
end; {CapCharAt}
function TCocoRScanner.CharAt(pos : longint) : char;
var
ch : char;
begin
if pos >= SourceLen then
begin
Result := _EF;
exit;
end;
SrcStream.Seek(pos, soFromBeginning);
SrcStream.ReadBuffer(Ch, 1);
if ch <> _EOF then
Result := ch
else
Result := _EF
end; {CharAt}
function TCocoRScanner.GetNStr(Symbol : TSymbolPosition; ChProc : TGetCh) : string;
var
i : integer;
p : longint;
begin
SetLength(Result, Symbol.Len);
p := Symbol.Pos;
i := 1;
while i <= Symbol.Len do
begin
Result[i] := ChProc(p);
inc(i);
inc(p)
end;
end; {GetNStr}
function TCocoRScanner.GetName(Symbol : TSymbolPosition) : string;
begin
Result := GetNStr(Symbol, CurrentCh);
end; {GetName}
function TCocoRScanner.GetStartState : PStartTable;
begin
Result := @fStartState;
end; {GetStartState}
procedure TCocoRScanner.SetStartState(aStartTable : PStartTable);
begin
fStartState := aStartTable^;
end; {SetStartState}
function TCocoRScanner.GetString(Symbol : TSymbolPosition) : string;
begin
Result := GetNStr(Symbol, CharAt);
end; {GetString}
procedure TCocoRScanner._Reset;
var
len : longint;
begin
{ Make sure that the stream has the _EF character at the end. }
CurrInputCh := _EF;
SrcStream.Seek(0, soFromEnd);
SrcStream.WriteBuffer(CurrInputCh, 1);
SrcStream.Seek(0, soFromBeginning);
LastInputCh := _EF;
len := SrcStream.Size;
SourceLen := len;
CurrLine := 1;
StartOfLine := -2;
BufferPosition := -1;
CurrentSymbol.Clear;
NextSymbol.Clear;
NumEOLInComment := 0;
ContextLen := 0;
NextCh;
end; {_Reset}
{ TCocoRGrammar }
procedure TCocoRGrammar.ClearErrors;
var
i : integer;
begin
for i := 0 to fErrorList.Count - 1 do
TCocoError(fErrorList[i]).Free;
fErrorList.Clear;
end; {ClearErrors}
constructor TCocoRGrammar.Create(AOwner : TComponent);
begin
inherited;
FGenListWhen := glOnError;
fClearSourceStream := true;
fListStream := TMemoryStream.Create;
fErrorList := TList.Create;
end; {Create}
destructor TCocoRGrammar.Destroy;
begin
fListStream.Clear;
fListStream.Free;
ClearErrors;
fErrorList.Free;
inherited;
end; {Destroy}
procedure TCocoRGrammar.Expect(n : integer);
begin
if CurrentInputSymbol = n then
Get
else
SynError(n);
end; {Expect}
procedure TCocoRGrammar.GenerateListing;
{ Generate a source listing with error messages }
var
i : integer;
eof : boolean;
lnr, errC : integer;
srcPos : longint;
line : string;
PrintErrorCount : boolean;
begin
if Assigned(BeforeGenList) then
BeforeGenList(Self);
srcPos := 0;
GetLine(srcPos, line, eof);
lnr := 1;
errC := 0;
while not eof do
begin
_StreamLine(PadL(IntToStr(lnr), ' ', 5) + ' ' + line);
for i := 0 to ErrorList.Count - 1 do
begin
if TCocoError(ErrorList[i]).Line = lnr then
begin
PrintErr(line, TCocoError(ErrorList[i]).ErrorCode,
TCocoError(ErrorList[i]).Col,
TCocoError(ErrorList[i]).Data);
inc(errC);
end;
end;
GetLine(srcPos, line, eof);
inc(lnr);
end;
// Now take care of the last line.
for i := 0 to ErrorList.Count - 1 do
begin
if TCocoError(ErrorList[i]).Line = lnr then
begin
PrintErr(line, TCocoError(ErrorList[i]).ErrorCode,
TCocoError(ErrorList[i]).Col,
TCocoError(ErrorList[i]).Data);
inc(errC);
end;
end;
PrintErrorCount := true;
if Assigned(AfterGenList) then
AfterGenList(Self, PrintErrorCount);
if PrintErrorCount then
begin
_StreamLine('');
_StreamLn(PadL(IntToStr(errC), ' ', 5) + ' error');
if errC <> 1 then
_StreamLine('s');
end;
end; {GenerateListing}
procedure TCocoRGrammar.GetLine(var pos : longint;
var line : string;
var eof : boolean);
{ Read a source line. Return empty line if eof }
var
ch : char;
i : integer;
begin
i := 1;
eof := false;
ch := Scanner.CharAt(pos);
inc(pos);
while not (ch in LineEnds) do
begin
SetLength(line, length(Line) + 1);
line[i] := ch;
inc(i);
ch := Scanner.CharAt(pos);
inc(pos);
end;
SetLength(line, i - 1);
eof := (i = 1) and (ch = _EF);
if ch = _CR then
begin { check for MsDos end of lines }
ch := Scanner.CharAt(pos);
if ch = _LF then
begin
inc(pos);
Extra := 0;
end;
end;
end; {GetLine}
function TCocoRGrammar.GetSourceStream : TMemoryStream;
begin
Result := Scanner.SrcStream;
end; {GetSourceStream}
function TCocoRGrammar.GetSuccessful : boolean;
begin
Result := ErrorList.Count = 0;
end; {GetSuccessful}
function TCocoRGrammar.LexName : string;
begin
Result := Scanner.GetName(Scanner.CurrentSymbol)
end; {LexName}
function TCocoRGrammar.LexString : string;
begin
Result := Scanner.GetString(Scanner.CurrentSymbol)
end; {LexString}
function TCocoRGrammar.LookAheadName : string;
begin
Result := Scanner.GetName(Scanner.NextSymbol)
end; {LookAheadName}
function TCocoRGrammar.LookAheadString : string;
begin
Result := Scanner.GetString(Scanner.NextSymbol)
end; {LookAheadString}
procedure TCocoRGrammar.PrintErr(line : string; ErrorCode : integer; col : integer; Data : string);
{ Print an error message }
procedure DrawErrorPointer;
var
i : integer;
begin
_StreamLn('***** ');
i := 0;
while i < col + Extra - 2 do
begin
if ((length(Line) > 0) and (length(Line) < i)) and (line[i] = _TAB) then
_StreamLn(_TAB)
else
_StreamLn(' ');
inc(i)
end;
_StreamLn('^ ')
end; {DrawErrorPointer}
begin {PrintErr}
DrawErrorPointer;
_StreamLn(ErrorStr(ErrorCode, Data));
_StreamLine('')
end; {PrintErr}
procedure TCocoRGrammar.SemError(const errNo : integer; const Data : string);
begin
if errDist >= minErrDist then
Scanner.ScannerError(errNo, Scanner.CurrentSymbol, Data, etSymantic);
errDist := 0;
end; {SemError}
procedure TCocoRGrammar._StreamLn(s : string);
begin
if length(s) > 0 then
ListStream.WriteBuffer(s[1], length(s));
end; {_StreamLn}
procedure TCocoRGrammar._StreamLine(s : string);
begin
s := s + chEOL;
_StreamLn(s);
end; {_StreamLine}
procedure TCocoRGrammar.SynError(const errNo : integer);
begin
if errDist >= minErrDist then
Scanner.ScannerError(errNo, Scanner.NextSymbol, '', etSyntax);
errDist := 0;
end; {SynError}
procedure TCocoRGrammar.SetOnStatusUpdate(const Value : TStatusUpdateProc);
begin
FOnStatusUpdate := Value;
Scanner.OnStatusUpdate := Value;
end; {SetOnStatusUpdate}
procedure TCocoRGrammar.SetSourceStream(const Value : TMemoryStream);
begin
Scanner.SrcStream := Value;
end; {SetSourceStream}
procedure TCocoRGrammar.StoreError(nr : integer; Symbol : TSymbolPosition;
Data : string; ErrorType : integer);
{ Store an error message for later printing }
var
Error : TCocoError;
begin
Error := TCocoError.Create;
Error.ErrorCode := nr;
if Assigned(Symbol) then
begin
Error.Line := Symbol.Line;
Error.Col := Symbol.Col;
end
else
begin
Error.Line := 0;
Error.Col := 0;
end;
Error.Data := Data;
Error.ErrorType := ErrorType;
ErrorList.Add(Error);
if Assigned(OnError) then
OnError(self, Error);
end; {StoreError}
function TCocoRGrammar.GetLineCount: integer;
begin
Result := Scanner.CurrLine;
end; {GetLineCount}
function TCocoRGrammar.GetCharacterCount: integer;
begin
Result := Scanner.BufferPosition;
end; {GetCharacterCount}
procedure TCocoRGrammar.DoBeforeParse;
begin
if Assigned(fBeforeParse) then
fBeforeParse(Self);
if Assigned(fOnStatusUpdate) then
fOnStatusUpdate(Self, cstBeginParse, '', -1);
end; {DoBeforeParse}
procedure TCocoRGrammar.DoAfterParse;
begin
if Assigned(fOnStatusUpdate) then
fOnStatusUpdate(Self, cstEndParse, '', -1);
if Assigned(fAfterParse) then
fAfterParse(Self);
end; {DoAfterParse}
function TCocoRGrammar.Bookmark: string;
begin
Result :=
IntToStr(fCurrentInputSymbol) + BOOKMARK_STR_SEPARATOR
+ Scanner.Bookmark;
end; {Bookmark}
procedure TCocoRGrammar.GotoBookmark(aBookmark: string);
var
BookmarkToken : string;
begin
try
BookmarkToken := StrTok(aBookmark, BOOKMARK_STR_SEPARATOR);
fCurrentInputSymbol := StrToInt(BookmarkToken);
Scanner.GotoBookmark(aBookmark);
except
on EConvertError do
Raise ECocoBookmark.Create(INVALID_INTEGER);
else
Raise;
end;
end; {GotoBookmark}
{ TCommentList }
procedure TCommentList.Add(const S : string; const aLine : integer;
const aColumn : integer);
var
CommentItem : TCommentItem;
begin
CommentItem := TCommentItem.Create;
try
CommentItem.Comment := FixComment(S);
CommentItem.Line := aLine;
CommentItem.Column := aColumn;
fList.Add(CommentItem);
except
CommentItem.Free;
end;
end; {Add}
procedure TCommentList.Clear;
var
i : integer;
begin
for i := 0 to fList.Count - 1 do
TCommentItem(fList[i]).Free;
fList.Clear;
end; {Clear}
constructor TCommentList.Create;
begin
fList := TList.Create;
end; {Create}
destructor TCommentList.Destroy;
begin
Clear;
if Assigned(fList) then
begin
fList.Free;
fList := NIL;
end;
inherited;
end; {Destroy}
function TCommentList.FixComment(const S: string): string;
begin
Result := S;
while (length(Result) > 0) AND (Result[length(Result)] < #32) do
Delete(Result,Length(Result),1);
end; {FixComment}
function TCommentList.GetColumn(Idx: integer): integer;
begin
Result := TCommentItem(fList[Idx]).Column;
end; {GetColumn}
function TCommentList.GetComments(Idx: integer): string;
begin
Result := TCommentItem(fList[Idx]).Comment;
end; {GetComments}
function TCommentList.GetCount: integer;
begin
Result := fList.Count;
end; {GetCount}
function TCommentList.GetLine(Idx: integer): integer;
begin
Result := TCommentItem(fList[Idx]).Line;
end; {GetLine}
function TCommentList.GetText: string;
var
i : integer;
begin
Result := '';
for i := 0 to Count - 1 do
begin
Result := Result + Comments[i];
if i < Count - 1 then
Result := Result + chEOL;
end;
end; {GetText}
procedure TCommentList.SetColumn(Idx: integer; const Value: integer);
begin
TCommentItem(fList[Idx]).Column := Value;
end; {SetColumn}
procedure TCommentList.SetComments(Idx: integer; const Value: string);
begin
TCommentItem(fList[Idx]).Comment := Value;
end; {SetComments}
procedure TCommentList.SetLine(Idx: integer; const Value: integer);
begin
TCommentItem(fList[Idx]).Line := Value;
end; {SetLine}
end.

BIN
components/flashfiler/sourcelaz/convert/ff1dataa.res Normal file
View File

Binary file not shown.

59
components/flashfiler/sourcelaz/convert/ff1intfc.dpr Normal file
View File

@ -0,0 +1,59 @@
{*********************************************************}
{* FlashFiler: Interface to the FlashFiler 1 DLL that is *}
{* used in the conversion utility to converte FlashFiler *}
{* 1.5x tables to 2.x *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
library FF1Intfc;
uses
SysUtils,
Classes,
uFF1Data;
{$R *.RES}
exports
FF1DirOpen,
FF1IsFileBLOB,
FF1TableOpen,
FF1TableClose,
FF1TableDataDictionary,
FF1TableFirst,
FF1TableNext,
FF1TableFieldValue,
FF1TableEOF,
FF1TableRecordCount,
FF1GetMem,
FF1FreeMem,
FF1ReallocMem,
FF1GetAutoInc;
begin
end.

60
components/flashfiler/sourcelaz/convert/ff1intfc.rc Normal file
View File

@ -0,0 +1,60 @@
/*********************************************************
* Main program icon resource *
*********************************************************/
/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */
#define VERSIONINFO_1 1
VERSIONINFO_1 VERSIONINFO
FILEVERSION 2, 1, 3, 0
PRODUCTVERSION 2, 1, 3, 0
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
{
BLOCK "StringFileInfo"
{
BLOCK "040904E4"
{
VALUE "CompanyName", "TurboPower Software Company\000\000"
VALUE "FileDescription", "FlashFiler 1 Conversion Interface\000"
VALUE "FileVersion", "2.1.3.0\000"
VALUE "InternalName", "FF1INTFC\000"
VALUE "LegalCopyright", "Copyright (c) TurboPower Software Co. 1996-2002\000\000"
VALUE "OriginalFilename", "FF1INTFC.DLL\000"
VALUE "ProductName", "FlashFiler (Delphi Edition)\000"
VALUE "ProductVersion", "2.1.3.0\000"
}
}
BLOCK "VarFileInfo"
{
VALUE "Translation", 0x409, 1252
}
}

BIN
components/flashfiler/sourcelaz/convert/ff1intfc.res Normal file
View File

Binary file not shown.

49
components/flashfiler/sourcelaz/convert/ffcnvrt.dpr Normal file
View File

@ -0,0 +1,49 @@
{*********************************************************}
{* FlashFiler: GUI FF1->FF2 conversion utility *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
program FFCnvrt;
uses
FFMemMgr in 'FFMemMgr.pas',
{$IFDEF USETeDEBUG}
TeDebug,
{$ENDIF}
Forms,
uFF2Cnv in 'uFF2Cnv.pas' {frmFF2Conv},
uFFNet in 'uFFNet.pas' {frmFFransport};
{$R *.RES}
begin
Application.Initialize;
Application.HelpFile := 'ffcnvrt.hlp';
Application.CreateForm(TfrmFF2Conv, frmFF2Conv);
Application.Run;
end.

60
components/flashfiler/sourcelaz/convert/ffcnvrt.rc Normal file
View File

@ -0,0 +1,60 @@
/*********************************************************
* Main program icon resource *
*********************************************************/
/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */
#define VERSIONINFO_1 1
VERSIONINFO_1 VERSIONINFO
FILEVERSION 2, 1, 3, 0
PRODUCTVERSION 2, 1, 3, 0
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
{
BLOCK "StringFileInfo"
{
BLOCK "040904E4"
{
VALUE "CompanyName", "TurboPower Software Company\000\000"
VALUE "FileDescription", "FlashFiler 2 Converter\000"
VALUE "FileVersion", "2.1.3.0\000"
VALUE "InternalName", "FFCNVRT\000"
VALUE "LegalCopyright", "Copyright (c) TurboPower Software Co. 1996-2002\000\000"
VALUE "OriginalFilename", "FFCNVRT.EXE\000"
VALUE "ProductName", "FlashFiler (Delphi Edition)\000"
VALUE "ProductVersion", "2.1.3.0\000"
}
}
BLOCK "VarFileInfo"
{
VALUE "Translation", 0x409, 1252
}
}

BIN
components/flashfiler/sourcelaz/convert/ffcnvrt.res Normal file
View File

Binary file not shown.

396
components/flashfiler/sourcelaz/convert/ffcnvrtc.dpr Normal file
View File

@ -0,0 +1,396 @@
{*********************************************************}
{* FlashFiler: Command line conversion utility *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
program FFCnvrtC;
{$APPTYPE CONSOLE}
uses
FFMemMgr,
{$IFDEF USETeDEBUG}
TeDebug,
{$ENDIF}
Classes,
SysUtils,
FileCtrl,
Windows,
FFConvrt,
FFSrEng,
FFLLEng,
FFLLComp;
{$R *.RES}
type
FF2CvtErrorCode = (cecNone,
{No errors}
cecNoDestination,
{Target parameter doesn't exist}
cecNoSource,
{One of the source files does not exist}
cecTooManySources,
{Only 1 source parameter is allowed}
cecNoTables,
{no tables were listed or in the source directory}
cecInvalidTable,
{The table doesn't exist in the source directory}
cecOverwrite,
{There are file(s) of the same name as a source
file in the destination directory}
cecInvalidSource,
{No valid source directory were given}
cecInvalidDestination,
{No valid target directory was given}
cecDataConvertFailed,
{The data conversion failed}
cecNoParameters,
{No parameters given}
cecUnknownFailure);
{Conversion Failed: unknown reason}
{This class is only here to provide a event handler for
TffDataConverter.OnProgress event}
TFFConvUtil = class
public
procedure OnProgress(aSender : TffDataConverter);
end;
var
FF2Server : TffServerEngine;
TableConverter : TffDataConverter;
Utility : TFFConvUtil;
SourceTables : TStringList;
Destination : string;
SourceDir : string;
ScreenPos : TCoord;
CurrentTable : Integer;
GoodSource : Boolean;
GoodDest : Boolean;
{--------}
function WillOverwrite : boolean;
var
i : integer;
begin
Result := False;
{check if any of the selected files in srcFiles have the same name
as any files in the destination directory.}
for i := 0 to pred(SourceTables.Count) do begin
{Ensure this file isn't in the destination directory.}
if FileExists((Destination + '\' + ChangeFileExt(SourceTables[i], '.FF2'))) then begin
writeln(format('*** ERROR: %s already in destination ***', [ExtractFileName(SourceTables[i])]));
writeln;
ExitCode := integer(cecOverwrite);
Result := True;
Exit;
end;
end;
end;
{--------}
procedure DisplayHelp;
begin
writeln('Converts a FlashFiler 1 table to a FlashFiler 2 table.');
writeln;
writeln('FFCnvrtC -s<complete source path> -d<complete destination path> [-t<table name>]');
writeln('Multiple tables can be listed or leave off the table parameter');
writeln('to convert all tables in the source.');
writeln('Example:');
writeln(' FFCnvrtC -sC:\MyApp -dC:\MyNewApp -tTable1 -tTable2');
writeln;
end;
{--------}
procedure BuildTableList;
var
ATable : TSearchRec;
CurrTable : string;
i : integer;
begin
{are table parameters given?}
if (StrPos(CmdLine, '-t') <> nil) then begin
{yes. we need to add each table to SourceTables}
for i := 1 to ParamCount do begin
{if the second letter in the parameter is an t, it's a table}
if IsDelimiter('t', ParamStr(i), 2) then begin
CurrTable := ParamStr(i);
{strip delimiter off table parameter}
Delete(CurrTable, 1, 2);
{does the target file actually exist?}
if FileExists(SourceDir + '\' + CurrTable + '.FFD') then begin
{add the table to SourceTables}
SourceTables.Add(CurrTable + '.FFD');
end else begin
writeln(format('*** ERROR: %s doesn''t exist ***', [CurrTable + '.FFD']));
writeln;
ExitCode := integer(cecInvalidTable);
Exit;
end;
end;
end;
end else begin
{add all tables in the source directory to the SourceTables list}
{are there any tables in the source directory}
if FindFirst(SourceDir + '\*.FFD', faAnyFile, ATable) = 0 then begin
{yes. good, add each of them to the SourceTables list}
SourceTables.Add(ATable.Name);
while FindNext(ATable) = 0 do begin
SourceTables.Add(ATable.Name);
end;
end else begin
{no. Not good, we were expecting at least 1 FlashFiler table
here.}
ExitCode := integer(cecNoTables);
Exit;
end;
SysUtils.FindClose(ATable);
end;
end;
{--------}
function IsSameDatabase : boolean;
begin
{ensure that we are not trying to put our new file in the same
directory as the old file.}
{Assumption: local paths - No UNCs}
Result := UpperCase(Destination) = UpperCase(SourceDir);
end;
{--------}
function IsValidDest : boolean;
var
i : integer;
begin
Result := False;
{Does the command line contain a source parameter?}
if (StrPos(CmdLine, '-d') <> nil) then begin
{yes. we need to parse out the target directory name}
for i := 1 to ParamCount do begin
{if the second letter in the parameter is an d, it's a source}
if IsDelimiter('d', ParamStr(i), 2) then begin
Destination := ParamStr(i);
{strip delimiter off string}
Delete(Destination, 1, 2);
{does the target file actually exist?}
if DirectoryExists(Destination) then begin
Result := True;
{Remove the trailing "\" if it's there}
if Destination[Length(Destination)] = '\' then
Delete(Destination, Length(Destination), 1);
{we're exiting if we get a valid target because there can
only be a single destination}
exit;
end else begin
writeln(format('*** ERROR: %s doesn''t exist ***', [Destination]));
writeln;
ExitCode := integer(cecInvalidDestination);
Result := False;
Exit;
end;
end; {if}
end; {for}
end else
ExitCode := integer(cecNoDestination);
if ((not Result) and (ExitCode = 0)) then
ExitCode := integer(cecInvalidDestination);
end;
{--------}
function IsValidSource : Boolean;
var
CurrParam : string;
i : Integer;
FirstSource : Boolean;
begin
FirstSource := False;
Result := False;
{Does the command line contain a source parameter?}
if (StrPos(CmdLine, '-s') <> nil) then begin
{if so we need to parse out each source}
for i := 1 to ParamCount do begin
{if the second letter in the parameter is an s, it's a source}
if IsDelimiter('s', ParamStr(i), 2) then begin
{ensure only 1 source parameter is listed}
if not FirstSource then
FirstSource := True
else begin
ExitCode := integer(cecTooManySources);
Exit;
end;
CurrParam := ParamStr(i);
{strip delimiter off parameter}
Delete(CurrParam, 1, 2);
{does the source file actually exist?}
if DirectoryExists(CurrParam) then begin
SourceDir := CurrParam;
if SourceDir[Length(SourceDir)] = '\' then
Delete(SourceDir, Length(SourceDir), 1);
Result := True;
end else begin
writeln(format('*** ERROR: %s doesn''t exist ***', [CurrParam]));
writeln;
Result := False;
ExitCode := (integer(cecInvalidSource));
Exit;
end; {if..else}
end; {if}
end; {for}
end else
ExitCode := integer(cecNoSource);
{if the source parameters aren't all valid and we haven't already
set an exit code, we will set the ExitCode to 'Invalid Source'}
if ((not Result) and (ExitCode = integer(cecNone))) then
ExitCode := integer(cecInvalidSource);
end;
{--------}
procedure ShowExitCodeMessage;
begin
case ExitCode of
integer(cecNone): writeln('*** Conversion successful ***');
integer(cecNoDestination): writeln('*** ERROR: No destination parameter ***');
integer(cecNoSource): writeln('*** ERROR: No source parameters ***');
integer(cecTooManySources): writeln('*** ERROR: Too many source directories ***');
integer(cecNoTables): writeln('*** ERROR: No tables to convert ***');
integer(cecDataConvertFailed): writeln('*** ERROR: Conversion failed ***');
integer(cecUnknownFailure): writeln('*** ERROR: Unknown failure ***');
end;
end;
{--------}
procedure DisplayStatus;
var
ConsoleOutputHandle : THandle;
begin
{reposition cursor}
ConsoleOutputHandle := GetStdHandle(STD_OUTPUT_HANDLE);
SetConsoleCursorPosition(ConsoleOutputHandle, ScreenPos);
Write(format('Table %d of %d - %d percent complete.',
[Succ(CurrentTable),
SourceTables.Count,
((TableConverter.RecordsProcessed * 100) div
TableConverter.TotalRecords)]));
end;
{--------}
procedure SetScreenPos;
var
ConsoleOutputHandle : THandle;
ScreenInfo : TConsoleScreenBufferInfo;
begin
{ get screen pos}
ConsoleOutputHandle := GetStdHandle(STD_OUTPUT_HANDLE);
GetConsoleScreenBufferInfo(ConsoleOutputHandle, ScreenInfo);
ScreenPos.X := ScreenInfo.dwCursorPosition.X;
ScreenPos.Y := ScreenInfo.dwCursorPosition.Y;
end;
{--------}
procedure ConvertTables;
var
i : integer;
begin
{Ensure we are not overwriting any tables that the user doesn't want
overwritten. If this isn't a problem, continue.}
if ExitCode = 0 then begin
if not WillOverwrite then begin
CurrentTable := -1;
for i := 0 to pred(SourceTables.Count) do begin
inc(CurrentTable);
{build the complete path to the table we're updating}
{convert the table}
try
Write(SourceTables[i] + ' ');
SetScreenPos;
Write(format('Table %d of %d - 100 percent complete.',
[Succ(CurrentTable), SourceTables.Count]));
TableConverter.Convert((SourceDir + '\' + SourceTables[i]), Destination);
Writeln;
except
on E: Exception do begin
writeln;
writeln(format('*** ERROR: Conversion of %s failed ***' + #13#10 +
'*** %s ***', [SourceTables[i], E.Message]));
ExitCode := integer(cecDataConvertFailed);
end;
end;
end;
end else
ExitCode := integer(cecOverwrite);
end;
end;
{--------}
procedure TFFConvUtil.OnProgress;
begin
DisplayStatus;
end;
{--------}
procedure InitializeUnit;
begin
ExitCode := 0;
{startup our server engine}
FF2Server := TffServerEngine.Create(nil);
FF2Server.Configuration.GeneralInfo.giNoAutoSaveCfg := True;
FF2Server.State := ffesStarted;
{setup our table converter and its events}
TableConverter := TffDataConverter.Create(FF2Server);
TableConverter.ProgressFrequency := 100;
{give ourself a 5 meg buffer for the FF2 server}
TableConverter.BufferSize := 1024 * 1024;
Utility := TFFConvUtil.Create;
TableConverter.OnProgress := Utility.OnProgress;
SourceTables := TStringList.Create;
end;
{--------}
procedure FinalizeUnit;
begin
SourceTables.Free;
TableConverter.Free;
FF2Server.State := ffesShuttingDown;
FF2Server.Free;
Utility.Free;
end;
{====================================================================}
begin
InitializeUnit;
try
if ParamCount > 0 then begin
GoodSource := IsValidSource;
if ExitCode = 0 then begin
GoodDest := IsValidDest;
if GoodSource and GoodDest and (ExitCode = 0) then begin
BuildTableList;
if ExitCode = 0 then
ConvertTables;
writeln;
end else
DisplayHelp;
end;
end else begin
ExitCode := integer(cecNoParameters);
DisplayHelp;
end;
finally
FinalizeUnit;
ShowExitCodeMessage;
end;
{====================================================================}
end.

60
components/flashfiler/sourcelaz/convert/ffcnvrtc.rc Normal file
View File

@ -0,0 +1,60 @@
/*********************************************************
* Main program icon resource *
*********************************************************/
/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */
#define VERSIONINFO_1 1
VERSIONINFO_1 VERSIONINFO
FILEVERSION 2, 1, 3, 0
PRODUCTVERSION 2, 1, 3, 0
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
{
BLOCK "StringFileInfo"
{
BLOCK "040904E4"
{
VALUE "CompanyName", "TurboPower Software Company\000\000"
VALUE "FileDescription", "FlashFiler Console Converter\000"
VALUE "FileVersion", "2.1.3.0\000"
VALUE "InternalName", "FFCNVRTC\000"
VALUE "LegalCopyright", "Copyright (c) TurboPower Software Co. 1996-2002\000\000"
VALUE "OriginalFilename", "FFCNVRTC.EXE\000"
VALUE "ProductName", "FlashFiler (Delphi Edition)\000"
VALUE "ProductVersion", "2.1.3.0\000"
}
}
BLOCK "VarFileInfo"
{
VALUE "Translation", 0x409, 1252
}
}

BIN
components/flashfiler/sourcelaz/convert/ffcnvrtc.res Normal file
View File

Binary file not shown.

972
components/flashfiler/sourcelaz/convert/ffconvrt.pas Normal file
View File

@ -0,0 +1,972 @@
{*********************************************************}
{* FlashFiler: TffDataConvertClass used to convert a *}
{* FlashFiler 1.xx table to a FlashFiler 2 *}
{* table. *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
unit FFConvrt;
{$I FFDEFINE.INC}
{$IFDEF DCC6OrLater}
!!! Conversion utilities should be compiled only with Delphi 5 or lower, and
!!! C++Builder 5 or lower. Using Delphi 6 or higher, or C++Builder 6 or higher
!!! would lead to an error because the D6 streams are incompatible with streams
!!! from D5 and lower.
{$ENDIF}
interface
uses
WinTypes, Classes, DB, FFLLDict, FFLLBase, FFLLEng, FFDB, FFLLExcp,
FFSRMgr;
type
TffDataConverter = class; {forward declaration}
{ FlashFiler v1.x DLL function types. }
TFF1TableDataDictionary = procedure(var aDict : TStream); stdcall;
TFF1TableFirst = procedure; stdcall;
TFF1TableNext = procedure; stdcall;
TFF1TableFieldValue = function(aFieldNo : Integer) : Variant; stdcall;
TFF1DirOpen = procedure(aPath : PChar); stdcall;
TFF1TableOpen = function(aTableName : PChar) : Integer; stdcall;
TFF1TableClose = procedure; stdcall;
TFF1TableEOF = function : boolean; stdcall;
TFF1TableRecordCount = function : Integer; stdcall;
TFF1IsFileBLOB = function(aFieldNo : Integer;
var aBuffer : array of Byte) : Boolean; stdcall;
TFF1SetNewMemMgr = function(aMemManager : TMemoryManager) : TMemoryManager; stdcall;
TFF1SetOldMemMgr = procedure(aMemMgr : TMemoryManager); stdcall;
TFF1GetAutoInc = function : Longint; stdcall;
{ TProtOptions is a record that holds settings for all the protocol
options.}
TffProtOptions = packed record
IsSingleUser : Boolean;
IsIPXSPX : Boolean;
IPXSPXLFB : Boolean;
IsTCPIP : Boolean;
TCPIPLFB : Boolean;
TCPIPPort : Longint;
UDPPortSr : Longint;
UDPPortCl : Longint;
IPXSocketSr : Longint;
IPXSocketCl : Longint;
SPXSocket : Longint;
TCPIntf : Longint;
end;
EffConverterException = class(EffException);
{ Event Types }
TffDataConverterEvent = procedure(aSender : TffDataConverter) of object;
{ Event type used for status events during the execution of the
converter}
TffDCNetBiosEvent = procedure(aSender : TffDataConverter;
var aCanceled : Boolean;
var aOptions : TffProtOptions) of object;
{ Since the NetBIOS protocol isn't supported in FF2, we raise this
type of event to give the application a chance to change the
protocol and provide options for the new protocol.}
{---FF1 to FF2 Converter Class---}
{ This class contains the business logic for converting a FlashFiler 1.x
file to the FlashFiler 2.0 file format.
Call the Convert method to convert a file. The converter opens the source
file in exclusive mode hence the file may not be opened by a server.
}
TffDataConverter = class
private
FAfterConvert : TffDataConverterEvent;
{ The method called after successfully completing the Convert Records
stage. }
FBeforeConvert : TffDataConverterEvent;
{ The method called before starting the Convert Records stage. }
FCanceled : Boolean;
{ Flag to stop the conversion process.}
FClient : TffClient;
{ The FF2 client used for the conversion. }
FCommitFrequency : TffWord32;
{ The number of records that must be converted before a
transaction is committed.}
FDatabase : TffDatabase;
{ The FF2 database used for the conversion. }
FDLLHandle : THandle;
{ Handle to the FF1 DLL.}
FFF2Table : TffTable;
{ The new FF2 table.}
FOnCancel : TffDataConverterEvent;
{ Event called if a conversion is aborted.}
FOnComplete : TffDataConverterEvent;
{ The method called after all operations are complete on a single
table.}
FOnNetBios : TffDCNetBiosEvent;
{ Since the NetBIOS protocol isn't supported in FF2, we raise
this event to give the application a chance to change the
protocol and provide options for the new protocol.}
FOnProgress : TffDataConverterEvent;
{ The method called during the conversion of records. It is
raised after converting the number of records specified by
ProgressFrequency. This event is raised at the very end of
the conversion if less than ProgressFrequency records were
processed since the last OnProgress event. }
FProgressFrequency : TffWord32;
{ The number of records that must be converted before the
OnProgress event may be raised. }
FBufferSize : TffWord32;
{ How big of a buffer to allow the converter to use. This is
used to determine how often transactions are committed.}
FRecordsProcessed : TffWord32;
{ This is the total number of records converted.}
FServerEngine : TffBaseServerEngine;
{ The FF2 server used for the conversion. }
FSession : TffSession;
{ The FF2 session used for the conversion. }
FSource : string;
{ The directory and name of the file being converted. }
FDestination : string;
{ The directory and name of the new file being created from the old
file. }
FTotalRecords : TffWord32;
{ The total number of records in the table that must be converted. }
procedure FFTableAfterOpen(aDataSet : TDataSet);
{ Used to get access to the FF2 table after it's opened.}
function IsFileBLOB(aField : TField; aFieldNo : Integer) : Boolean;
{ Fields that are stored as file BLOBs must be converted in a
different way than other fields. This function is used to
check for file-BLOB field types.}
procedure LoadFF1DLL;
{ Load the FF1 server from a DLL since we can't have a FF1 and
FF2 server in the same application.}
procedure ProcessGenInfo(const aFileName : string);
{ The FFSINFO is a FlashFiler system table that can't be handled
by the standard routine below. This procedure will convert
the FFSINFO table correctly.}
procedure SetBufferSize(aSize : TffWord32);
{ This function is called by the BufferSize property to set the
buffer size.}
{==FF1 Routine Types==}
protected
public
constructor Create(aServerEngine : TffBaseServerEngine);
destructor Destroy; override;
procedure Cancel;
{ Call this method to abort the conversion process.}
procedure Convert(const aSource : string;
const aDest : string);
{ Call this method to convert a file in the old format to a file
in the new format. This method raises an exception if an error
occurs.
aSource - The absolute path to an existing FFD file
in the old format. (Ex: c:\MyApp\MyTable.FFD)
aDest - The absolute path of the directory to which
aSource is being converted to. If a file
exists in aDest with the same filename that
is in aSource it will be overwritten.
(Ex: c:\MyNewApp) }
property AfterConvert : TffDataConverterEvent
read FAfterConvert
write FAfterConvert;
{ This event is raised after the record conversion stage has successfully
finished. If an error occurs during convert records then this event is
not raised. }
property BeforeConvert : TffDataConverterEvent
read FBeforeConvert
write FBeforeConvert;
{ This event is raised before the file is converted. When this method
is called, the converter will have opened the file and determined
how many records need to be converted. }
property BufferSize : TffWord32
read FBufferSize
write SetBufferSize
default 1024 * 1024;
{ Size of the buffer used by the converter. This number is used
to determine how often transactions are committed.}
property Canceled : Boolean read FCanceled;
{ Check if conversion was canceled.}
property OnCancel : TffDataConverterEvent
read FOnCancel
write FOnCancel;
{ The event called when a conversion is aborted.}
property OnComplete : TffDataConverterEvent
read FOnComplete
write FOnComplete;
{ The method called after all operations are complete on a table.}
property OnProgress : TffDataConverterEvent
read FOnProgress
write FOnProgress;
{ This event is raised after converting the number of records
specified by ProgressFrequency. This event is also raised at
the end of the conversion if fewer then ProgressFrequency
records were processed since the last OnProgress event. }
property OnNetBios : TffDCNetBiosEvent
read FOnNetBios
write FOnNetBios;
{ Since the NetBIOS protocol isn't supported in FF2, we raise
this event to give the application a chance to change the
protocol and provide options for the new protocol.}
property ProgressFrequency : TffWord32
read FProgressFrequency
write FProgressFrequency default 100;
{ The number of records that must be converted before the
OnProgress event will be raised. }
property RecordsProcessed : TffWord32 read FRecordsProcessed;
{ The number of records converted. This number is accurate at
the time OnProgress is raised. }
property Source : string read FSource;
{ The directory and name of the file being converted. }
property Destination : string read FDestination;
{ The drive and path of the location to place the new FF2 tables.}
property TotalRecords : TffWord32 read FTotalRecords;
{ The total number of records to be processed in the Convert Records
stage. }
property ServerEngine : TffBaseServerEngine read FServerEngine;
{ The FF2 server engine used to make the new (converted) table.}
end;
implementation
uses
SysUtils,
Dialogs,
Winsock,
{$IFDEF DCC6OrLater} {!!.06 - Start}
Variants,
{$ENDIF} {!!.06 - End}
FFClintf;
const
ffc_ConvAlias = 'ConvAlias';
var
ffStrResConverter : TffStringResource;
{ Functions mapped to FF1 DLL}
FF1DirOpen : TFF1DirOpen;
FF1TableClose : TFF1TableClose;
FF1TableDataDictionary : TFF1TableDataDictionary;
FF1TableEOF : TFF1TableEOF;
FF1TableFieldValue : TFF1TableFieldValue;
FF1TableFirst : TFF1TableFirst;
FF1TableNext : TFF1TableNext;
FF1TableOpen : TFF1TableOpen;
FF1TableRecordCount : TFF1TableRecordCount;
FF1IsFileBLOB : TFF1IsFileBLOB;
FF1SetNewMemMgr : TFF1SetNewMemMgr;
FF1SetOldMemMgr : TFF1SetOldMemMgr;
FF1GetAutoInc : TFF1GetAutoInc;
{$I FFCvCNST.INC}
{$R FFCVCNST.RES}
{===TffDataConverter=================================================}
procedure TffDataConverter.Cancel;
begin
FCanceled := True;
end;
{--------}
procedure TffDataConverter.Convert(const aSource : string;
const aDest : string);
var
FF2Dict : TffDataDictionary;
FF1DictStream : TMemoryStream;
Value : Variant;
OldFileName : AnsiString;
SourceDir : AnsiString;
Msg : TMsg;
FieldNumber : Integer;
FieldCount : Integer;
Data : Pointer;
begin
FTotalRecords := 0;
FRecordsProcessed := 0;
FSource := aSource;
OldFileName := ExtractFileName(aSource);
FDestination := aDest + '\' + ChangeFileExt(OldFileName, {!!.03}
'.' + ffc_ExtForData); {!!.03}
FCanceled := False;
{setup a FF2 table}
FFF2Table := TffTable.Create(nil);
FFF2Table.AfterOpen := FFTableAfterOpen;
try
FFF2Table.DatabaseName := FDatabase.DatabaseName;
FFF2Table.SessionName := FSession.SessionName;
FFF2Table.Timeout := -1;
{parse out the directory to the source file(s)}
SourceDir := ExtractFilePath(aSource);
{remove the trailing backslash from the directory}
Delete(SourceDir, Length(SourceDir), 1);
FF1DirOpen(PChar(SourceDir));
{extract the FF1 table name and remove its extension}
Delete(OldFileName, Length(OldFileName) - 3, 4);
{if we are able to open the FF1 table we'll start the conversion
process}
if FF1TableOpen(PChar(OldFileName)) <> 0 then begin
FFRaiseExceptionNoData(EffConverterException,
ffStrResConverter,
ffcverrFF1TableOpen)
end else begin
{add our alias if we haven't added it already}
if not FSession.IsAlias(ffc_ConvAlias) then begin
FSession.AddAlias(ffc_ConvAlias, PChar(aDest), False); {!!.11}
FDatabase.AliasName := ffc_ConvAlias;
end;
FDatabase.Open;
FTotalRecords := FF1TableRecordCount;
{ the rest of this routine will not properly convert a FF1
FFSINFO system table so we'll convert it in a separate procedure}
if UpperCase(OldFileName) = 'FFSINFO' then begin
ProcessGenInfo(OldFileName);
exit;
end;
{create a dictionary from the FF1 table that will be used in our
new FF2 table}
FF2Dict := TffDataDictionary.Create(4096);
{read the FF1 dictionary into a stream and then read it into the
new dictionary}
FF1DictStream := TMemoryStream.Create;
FF1TableDataDictionary(TStream(FF1DictStream));
FF1DictStream.Position := 0;
FF2Dict.ReadFromStream(FF1DictStream);
FF2Dict.FileDescriptor[0]^.fdExtension := ffc_ExtForData;
try
{create the new table}
if FFDbiCreateTable(FDatabase, True, OldFileName, FF2Dict) = 0 then begin
try
{don't prceed if the conversion has been canceled}
if not FCanceled then begin
{execute the BeforeConvert event if assigned}
if Assigned(FBeforeConvert) then
FBeforeConvert(self);
{name and open the new table}
FFF2Table.TableName := OldFileName;
FFF2Table.Exclusive := True;
FFF2Table.Open;
{now move to the first record in the FF1 table and iterate
through them - adding each record to the FF2 table, field-
by-field}
FF1TableFirst;
FDatabase.StartTransaction;
while ((not FF1TableEOF) and (not FCanceled)) do begin
FFF2Table.Insert;
{copy the value of each field to the FF2 record we're
inserting}
FieldCount := pred(FFF2Table.FieldCount);
for FieldNumber := 0 to FieldCount do begin
{we have to handle file BLOBs differently than other
field types else they will be added to the new table
as "normal" BLOBs -- and folks wouldn't like that. The
file BLOB process is contained within the call to
IsFileBLOB(..) for efficiency.}
if (not IsFileBLOB(FFF2Table.Fields[FieldNumber], FieldNumber)) then
try {!!.01}
if (FFF2Table.Dictionary.FieldType[FieldNumber] <> fftByteArray) then {!!.06 - Start}
FFF2Table.Fields[FieldNumber].Value :=
FF1TableFieldValue(FieldNumber)
else begin
Value := FF1TableFieldValue(FieldNumber);
if (Value <> NULL) then begin {!!.07 - Start}
Data := VarArrayLock(Value);
try
FFF2Table.Fields[FieldNumber].SetData(Data);
finally
VarArrayUnlock(Value);
end;
end; {!!.07 - End}
end; {!!.06 - End}
except {!!.01}
FCanceled := False; {!!.01}
raise; {!!.01}
end; {!!.01}
end; {for}
{post the new record}
FFF2Table.Post;
inc(FRecordsProcessed);
{move to the next record}
FF1TableNext;
{execute the OnProgress event if assigned and we're at one
of the progress points}
if ((Assigned(FOnProgress)) and (FProgressFrequency <> 0) and
(FRecordsProcessed mod FProgressFrequency = 0)) then begin
FOnProgress(self);
end;
if ((FCommitFrequency <> 0) and
(FRecordsProcessed mod FCommitFrequency = 0)) then begin
try
FDatabase.Commit;
except
{no need to rollback because we're deleting the table}
FCanceled := True;
raise;
end;
{process messages: there could have been a Cancel raised.}
if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
DispatchMessage(Msg);
FDatabase.StartTransaction;
end;
end; {while}
{we have to commit the outstanding transaction even if it
was canceled}
try
if FDatabase.InTransaction then
FDatabase.Commit;
if FFF2Table.Dictionary.HasAutoIncField(FieldNumber) then
FFDbiSetTableAutoIncValue(FFF2Table, FF1GetAutoInc);
except
{no need to rollback because we're deleting the table}
FCanceled := True;
raise;
end;
{only proceed if not canceled}
if not FCanceled then begin
{execute the OnProgress event if assigned to ensure we get
a final count on the number of records converted}
if ((Assigned(FOnProgress)) and
(FProgressFrequency <> 0) and
(FRecordsProcessed mod FProgressFrequency > 0)) then
FOnProgress(self);
{now we need to call the AfterConvert event}
if Assigned(FAfterConvert) then
FAfterConvert(self);
end; {if not canceled}
end; {if not canceled}
finally
{if an exception was raised during a conversion, it's
possible to have an open transaction. We need to see if
there's an open transaction and roll it back if so}
if FDatabase.InTransaction then
FDatabase.Rollback;
FFF2Table.Close;
FDatabase.Close;
if not FCanceled then begin
{we didn't complete the conversion if it was canceled.}
if Assigned(FOnComplete) then
FOnComplete(self);
end else begin
{if canceled, we raise the Canceled event, delete the
aborted table, and reset the canceled flag.}
if Assigned(FOnCancel) then
FOnCancel(self);
FDatabase.Open;
FFF2Table.DeleteTable;
FFF2Table.Close;
FDatabase.Close;
FCanceled := False;
end; {if..else}
FFF2Table.Free;
FFF2Table := nil; {!!.01}
FSession.DeleteAlias(ffc_ConvAlias);
FF1TableClose;
FF1DictStream.Free;
FF2Dict.Free;
end; {try..finally}
end else
FFRaiseException(EffConverterException, ffStrResConverter,
ffcverrFF2TableCreate,
[format('Couldn''t create new %s', [FDestination])])
except
on E: Exception do
if E.ClassType <> EffConverterException then
FFRaiseException(EffConverterException,
ffStrResConverter,
ffcverrFF2TableCreate,
[E.Message])
else
raise;
end;
end; {if}
except
on E: Exception do begin
FFF2Table.Free;
if E.ClassType <> EffConverterException then begin
FFRaiseExceptionNoData(EffConverterException,
ffStrResConverter,
ffcverrFF1TableOpen)
end else
raise;
end;
end;
end;
{--------}
constructor TffDataConverter.Create(aServerEngine: TffBaseServerEngine);
begin
FCanceled := False;
FServerEngine := aServerEngine;
LoadFF1DLL;
BufferSize := 1024 * 1024;
FCommitFrequency := 1000;
{setup our client}
FClient := TffClient.Create(nil);
FClient.ClientName := 'ConvClient' + IntToStr(GetCurrentThreadID);
FClient.ServerEngine := aServerEngine;
{setup our session}
FSession := TffSession.Create(nil);
FSession.ClientName := FClient.ClientName;
FSession.SessionName := 'ConvSess' + IntToStr(GetCurrentThreadID);
FSession.Open;
{setup a database}
FDatabase := TffDatabase.Create(nil);
FDatabase.SessionName := FSession.SessionName;
FDatabase.DatabaseName := ffc_ConvAlias;
end;
{--------}
destructor TffDataConverter.Destroy;
begin
{free the database}
FDatabase.Free;
{free the session}
FSession.Free;
{free the client}
FClient.Free;
if FDLLHandle <> 0 then
FreeLibrary(FDLLHandle);
inherited;
end;
{--------}
procedure TffDataConverter.FFTableAfterOpen(aDataSet : TDataSet);
var
TempFreq : Integer;
begin
if ((FBufferSize <= 0) or
(aDataSet = nil)) then
Exit;
if aDataSet.Active then begin
TempFreq := Integer(FBufferSize) div
TffTable(aDataSet).Dictionary.RecordLength;
{Begin !!.03}
{ensure we have a min commit freq of 10 records}
if TempFreq > 10 then begin
if TffTable(aDataSet).Dictionary.HasBLOBFields then
FCommitFrequency := 10
else
FCommitFrequency := TempFreq;
end
else
FCommitFrequency := 10;
{End !!.03}
end else
FCommitFrequency := 1000;
end;
{--------}
function TffDataConverter.IsFileBLOB(aField : TField;
aFieldNo : Integer) : Boolean;
var
FileName : string[255];
Buffer : array[0..255] of Byte;
begin
Result := False;
if aField is TBLOBField then begin
Result := FF1IsFileBLOB(aFieldNo, Buffer);
if Result then begin
SetLength(FileName, Buffer[0]);
Move(Buffer[1], FileName[1], Buffer[0]);
FFDbiAddFileBLOB(FFF2Table, succ(aFieldNo), FileName);
end;
end; {if}
end;
{--------}
procedure TffDataConverter.LoadFF1DLL;
var
Msg, Msg2 : string;
ErrorMode : Word;
begin
{ Use setErrorMode to prohibit the Windows error dialog that appears if the
DLL is not found. Load the DLL dynamically. }
ErrorMode := SetErrorMode(SEM_NoOpenFileErrorBox);
FDllHandle := LoadLibrary('FF1Intfc.DLL');
SetErrorMode(ErrorMode);
FDLLHandle := GetModuleHandle('FF1Intfc.DLL');
if FDllHandle = 0 then
begin
Msg := 'Unable to load DLL FF1Intfc. ';
case GetLastError of
0 : Msg2 := 'System out of memory, executable corrupt, ' +
'or relocations invalid.';
2 : Msg2 := 'File not found.';
3 : Msg2 := 'Path not found.';
8 : Msg2 := 'There is insufficient memory to load the DLL.';
10 : Msg2 := 'The Windows version of the DLL is incorrect.';
else
Msg2 := '';
end; { case }
raise Exception.Create(Msg + Msg2 + ' Unable to run conversion.');
end { if dll not loaded }
else begin
{map our function calls to the FF1 DLL}
@FF1TableDataDictionary := GetProcAddress(FDLLHandle, 'FF1TableDataDictionary');
@FF1TableFirst := GetProcAddress(FDLLHandle, 'FF1TableFirst');
@FF1TableNext := GetProcAddress(FDLLHandle, 'FF1TableNext');
@FF1TableFieldValue := GetProcAddress(FDLLHandle, 'FF1TableFieldValue');
@FF1DirOpen := GetProcAddress(FDLLHandle, 'FF1DirOpen');
@FF1TableOpen := GetProcAddress(FDLLHandle, 'FF1TableOpen');
@FF1TableClose := GetProcAddress(FDLLHandle, 'FF1TableClose');
@FF1TableEOF := GetProcAddress(FDLLHandle, 'FF1TableEOF');
@FF1TableRecordCount := GetProcAddress(FDLLHandle, 'FF1TableRecordCount');
@FF1IsFileBLOB := GetProcAddress(FDLLHandle, 'FF1IsFileBLOB');
@FF1SetNewMemMgr := GetProcAddress(FDLLHandle, 'FF1SetNewMemManager');
@FF1SetOldMemMgr := GetProcAddress(FDLLHandle, 'FF1SetOldMemManager');
@FF1GetAutoInc := GetProcAddress(FDLLHandle, 'FF1GetAutoInc');
end;
end;
{--------}
procedure TffDataConverter.ProcessGenInfo(const aFileName : string);
var
FF1DictStream : TMemoryStream;
FF1Dict : TffDataDictionary;
FF2Dict : TffDataDictionary;
ProtocolString : string;
NewFileName : string;
FieldNumber : Integer;
IsNotCanceled : Boolean;
SkipProtocols : Boolean;
ProtOptions : TffProtOptions;
begin
{since some of the earlier FF1 tables don't have all the fields that
v1.56 has we need FF1's dictionary so we can get its field count.}
FF1DictStream := TMemoryStream.Create;
FF1TableDataDictionary(TStream(FF1DictStream));
FF1Dict := TffDataDictionary.Create(4096);
FF1DictStream.Position := 0;
FF1Dict.ReadFromStream(FF1DictStream);
{we'll build the dictionary to build our new FF2 table}
FF2Dict := TffDataDictionary.Create(4096);
with FF2Dict do begin
AddField('ServerName', '', fftShortString,
pred(sizeof(TffNetName)), 0, true, nil);
AddField('MaxPages', '', fftWord32, 0, 0, True, nil);
AddField('IsSecure', '', fftBoolean, 0, 0, True, nil);
AddField('AutoUp', '', fftBoolean, 0, 0, True, nil);
AddField('AutoMini', '', fftBoolean, 0, 0, True, nil);
AddField('DebugLog', '', fftBoolean, 0, 0, True, nil);
AddField('UseSingleUser', '', fftBoolean, 0, 0, True, nil);
AddField('UseIPXSPX', '', fftBoolean, 0, 0, True, nil);
AddField('IPXSPXLFB', '', fftBoolean, 0, 0, True, nil);
AddField('UseTCPIP', '', fftBoolean, 0, 0, True, nil);
AddField('TCPIPLFB', '', fftBoolean, 0, 0, True, nil);
AddField('TCPPort', '', fftInt32, 0, 0, True, nil);
AddField('UDPPortSr', '', fftInt32, 0, 0, True, nil);
AddField('UDPPortCl', '', fftInt32, 0, 0, True, nil);
AddField('IPXSocketSr', '', fftInt32, 0, 0, True, nil);
AddField('IPXSocketCl', '', fftInt32, 0, 0, True, nil);
AddField('SPXSocket', '', fftInt32, 0, 0, True, nil);
AddField('UseEncrypt', '', fftBoolean, 0, 0, True, nil);
AddField('ReadOnly', '', fftBoolean, 0, 0, True, nil);
AddField('LstMsgIntvl', '', fftInt32, 0, 0, True, nil);
AddField('KAInterval', '', fftInt32, 0, 0, True, nil);
AddField('KARetries', '', fftInt32, 0, 0, True, nil);
AddField('Priority', '', fftInt32, 0, 0, True, nil);
AddField('TCPInterface', '', fftInt32, 0, 0, True, nil);
AddField('NoAutoSaveCfg', '', fftBoolean, 0, 0, True, nil);
Addfield('TempStoreSize', '', fftInt32, 0, 0, True, nil);
AddField('CollectEnabld', '', fftBoolean, 0, 0, True, nil); {!!.01}
AddField('CollectFreq', '', fftInt32, 0, 0, True, nil); {!!.01}
end;
{create the new table}
NewFileName := ExtractFileName(FDestination);
if FFDbiCreateTable(FDatabase, True, aFileName, FF2Dict) = 0 then begin
try
{execute the BeforeConvert event if assigned}
if Assigned(FBeforeConvert) then
FBeforeConvert(self);
{name and open the new table}
FFF2Table.TableName := NewFileName;
FFF2Table.Open;
{now we'll move to the first record in the FF1 table and
iterate through them - adding each record to the FF2 table}
FF1TableFirst;
FFF2Table.Insert;
{we know the first six fields will match so we'll just copy
those over to the new table.}
FFF2Table.Fields[0].Value := FF1TableFieldValue(0); {ServerName}
{we are going to assume that all the old RAM pages were for a
4K block size and then round up to turn the memory used for
the old RAM pages into megabytes of RAM in the new table.}
FFF2Table.Fields[1].Value := (((FF1TableFieldValue(1) * 4096) +
pred(1024 * 1024)) {to prevent 0 MB RAM}
div (1024 * 1024));
for FieldNumber := 2 to 5 do
FFF2Table.Fields[FieldNumber].Value := FF1TableFieldValue(FieldNumber);
{setup the protocols}
SkipProtocols := False;
ProtocolString := FF1TableFieldValue(6);
if ProtocolString = '' then begin
FFF2Table.Fields[6].Value := True; {SingleUser}
FFF2Table.Fields[7].Value := False; {IPXSPX}
FFF2Table.Fields[8].Value := False; {IPXSPXLFB}
FFF2Table.Fields[9].Value := False; {TCPIP}
FFF2Table.Fields[10].Value := False; {TCPIPLFB}
end else if ProtocolString = 'TCP/IP' then begin
FFF2Table.Fields[6].Value := False;
FFF2Table.Fields[7].Value := False;
FFF2Table.Fields[8].Value := False;
FFF2Table.Fields[9].Value := True;
FFF2Table.Fields[10].Value := FF1TableFieldValue(7);
end else if ProtocolString = 'IPX/SPX' then begin
FFF2Table.Fields[6].Value := False;
FFF2Table.Fields[7].Value := True;
FFF2Table.Fields[8].Value := FF1TableFieldValue(7);
FFF2Table.Fields[9].Value := False;
FFF2Table.Fields[10].Value := False;
end else if ProtocolString = 'SINGLE' then begin
FFF2Table.Fields[6].Value := True;
FFF2Table.Fields[7].Value := False;
FFF2Table.Fields[8].Value := False;
FFF2Table.Fields[9].Value := False;
FFF2Table.Fields[10].Value := False;
end else if ProtocolString = 'NETBIOS' then begin
{NetBios has been removed from FF2 so we need to have the
user select a new protocol before converting the table or
find a way to have the application select new protocol and
assign it during the conversion.}
SkipProtocols := True;
if Assigned(FOnNetBios) then begin
{yes. initialize ProtOptions and raise the FOnNetBIOS event
so the using application can get updated protocol options
and update ProtOptions. We will use ProtOptions to
initialize the protocol options of the table.}
with ProtOptions do begin
IsSingleUser := False;
IsIPXSPX := False;
IPXSPXLFB := False;
IsTCPIP := False;
TCPIPLFB := False;
{FF1 stored the TCPIP port incorrectly, so we'll convert
it now. We are also changing the defaults in FF2.}
TCPIPPort := htons(FF1TableFieldValue(8));
if TCPIPPort = 24677 then
TCPIPPort := 25445;
UDPPortSr := htons(FF1TableFieldValue(9));
if UDPPortSr = 24677 then
UDPPortSr := 25445;
UDPPortCl := htons(FF1TableFieldValue(10));
if UDPPortCl = 24933 then
UDPPortCl := 25701;
IPXSocketSr := htons(FF1TableFieldValue(11));
if IPXSocketSr = 24677 then
IPXSocketSr := 25445;
IPXSocketCl := htons(FF1TableFieldValue(12));
if IPXSocketCl = 24933 then
IPXSocketCl := 25701;
SPXSocket := htons(FF1TableFieldValue(13));
if SPXSocket = 25189 then
SPXSocket := 25957;
if FF1Dict.FieldCount > 20 then
TCPIntf := FF1TableFieldValue(20)
else
TCPIntf := 0;
{now that we've setup the previous protocol options we
can raise the event with the previous settings}
FOnNetBIOS(self, IsNotCanceled, ProtOptions);
{assign the values returned to the appropriate FF2 field}
FFF2Table.Fields[6].Value := IsSingleUser;
FFF2Table.Fields[7].Value := IsIPXSPX;
FFF2Table.Fields[8].Value := IPXSPXLFB;
FFF2Table.Fields[9].Value := IsTCPIP;
FFF2Table.Fields[10].Value := TCPIPLFB;
FFF2Table.Fields[11].Value := TCPIPPort;
FFF2Table.Fields[12].Value := UDPPortSr;
FFF2Table.Fields[13].Value := UDPPortCl;
FFF2Table.Fields[14].Value := IPXSocketSr;
FFF2Table.Fields[15].Value := IPXSocketCl;
FFF2Table.Fields[16].Value := SPXSocket;
FFF2Table.Fields[23].Value := TCPIntf;
end; {with}
end else begin
{if the FOnNetBIOS isn't assigned, setup all protocol
settings to defaults.}
FFF2Table.Fields[6].Value := True;
FFF2Table.Fields[7].Value := False;
FFF2Table.Fields[8].Value := False;
FFF2Table.Fields[9].Value := False;
FFF2Table.Fields[10].Value := False;
FFF2Table.Fields[11].Value := 25445;
FFF2Table.Fields[12].Value := 25445;
FFF2Table.Fields[13].Value := 25701;
FFF2Table.Fields[14].Value := 25445;
FFF2Table.Fields[15].Value := 25701;
FFF2Table.Fields[16].Value := 25957;
FFF2Table.Fields[23].Value := 0;
end;
end;
{we can match up FF1 fields 8 through 13 with FF2 fields
12 through 17. We will skip this section if we've already
setup the protocols.}
if not SkipProtocols then begin
{since FF1 stored the TCP/IP port incorrectly, correct it now}
FFF2Table.Fields[11].Value := htons(FF1TableFieldValue(8));
if FFF2Table.Fields[11].Value = 24677 then
FFF2Table.Fields[11].Value := 25445;
FFF2Table.Fields[12].Value := htons(FF1TableFieldValue(9));
if FFF2Table.Fields[12].Value = 24677 then
FFF2Table.Fields[12].Value := 25445;
FFF2Table.Fields[13].Value := htons(FF1TableFieldValue(10));
if FFF2Table.Fields[13].Value = 24933 then
FFF2Table.Fields[13].Value := 25701;
FFF2Table.Fields[14].Value := htons(FF1TableFieldValue(11));
if FFF2Table.Fields[14].Value = 24677 then
FFF2Table.Fields[14].Value := 25445;
FFF2Table.Fields[15].Value := htons(FF1TableFieldValue(12));
if FFF2Table.Fields[15].Value = 24933 then
FFF2Table.Fields[15].Value := 25701;
FFF2Table.Fields[16].Value := htons(FF1TableFieldValue(13));
if FFF2Table.Fields[16].Value = 25189 then
FFF2Table.Fields[16].Value := 25957;
end;
{we may be able to match up the rest of the FF1 fields, but
all fields may not be present in all FF1 tables depending on
what version of FF the tables were created with. We will
assign default values for any fields not in the FF1 table.}
{AllowEncrypt?}
if FF1Dict.FieldCount > 14 then
FFF2Table.Fields[17].Value := FF1TableFieldValue(14)
else
FFF2Table.Fields[17].Value := False;
{ReadOnly? - Although this is the same name as the old setting
it a new setting to turn off all output from the server}
FFF2Table.Fields[18].Value := False;
if FF1Dict.FieldCount > 16 then begin
for FieldNumber := 19 to 21 do
FFF2Table.Fields[FieldNumber].Value :=
FF1TableFieldValue(FieldNumber - 3);
end else begin
{set to defaults if they weren't in the FF1 table}
FFF2Table.Fields[19].Value := 5000; {LastMsgInterval}
FFF2Table.Fields[20].Value := 2500; {KAInterval}
FFF2Table.Fields[21].Value := 5; {KARetries}
end;
if FF1Dict.FieldCount > 19 then
FFF2Table.Fields[22].Value := FF1TableFieldValue(19)
else
{set the priority to "normal" if it wasn't in the FF1 table}
FFF2Table.Fields[22].Value := 2;
{set the default TCP and IPX interfaces}
if not SkipProtocols then begin
if FF1Dict.FieldCount > 20 then
FFF2Table.Fields[23].Value := FF1TableFieldValue(20)
else
FFF2Table.Fields[23].Value := 0;
end;
{NoAutoSaveCfg - we set this value according to the old
ReadOnly setting since the functionality matches}
FFF2Table.Fields[24].Value := FF1TableFieldValue(15);
{New settings added for FF2 and their defaults}
FFF2Table.Fields[25].Value := ffcl_TempStorageSize; {Temp storage size (MB)}
FFF2Table.Fields[26].Value := True; {Garbage collection enabled}
FFF2Table.Fields[27].Value := ffcl_CollectionFrequency; {Garbage collection frequency (ms)}
{post the new record}
FFF2Table.Post;
inc(FRecordsProcessed);
{execute the OnProgress event if assigned and we're at one
of the progress points}
if ((Assigned(FOnProgress)) and
(FRecordsProcessed mod FProgressFrequency = 0)) then
FOnProgress(self);
{now we need to call the AfterConvert event}
if Assigned(FAfterConvert) then
FAfterConvert(self);
finally
FFF2Table.Close;
FDatabase.Close; {!!.01}
if not FCanceled then begin
{we didn't complete the conversion if it was canceled.}
if Assigned(FOnComplete) then
FOnComplete(self);
end else begin
{if canceled, we raise the Canceled event, delete the
aborted table, and reset the canceled flag.}
if Assigned(FOnCancel) then
FOnCancel(self);
FFF2Table.DeleteTable;
FCanceled := False;
end; {if..else}
FFF2Table.Free;
{FDatabase.Close;} {!!.01 Moved above}
FSession.DeleteAlias(ffc_ConvAlias);
FF1TableClose;
FF2Dict.Free;
FF1DictStream.Free;
FF1Dict.Free;
end;
end else
FFRaiseException(EffConverterException, ffStrResConverter,
ffcverrFF2TableCreate,
[format('Couldn''t create new %s', [FDestination])])
end;
{--------}
procedure TffDataConverter.SetBufferSize(aSize : TffWord32);
begin
FBufferSize := aSize;
if aSize <= 0 then
FFRaiseExceptionNoData(EffConverterException,
ffStrResConverter,
FFCvErrZeroCommitFreq);
FFTableAfterOpen(FFF2Table);
end;
{====================================================================}
procedure InitializeUnit;
begin
ffStrResConverter := nil;
ffStrResConverter := TffStringResource.Create(hInstance, 'FF_CONVERTER_STRINGS');
end;
procedure FinalizeUnit;
begin
ffStrResConverter.Free;
end;
initialization
InitializeUnit;
finalization
FinalizeUnit;
{====================================================================}
end.

35
components/flashfiler/sourcelaz/convert/ffcvcnst.inc Normal file
View File

@ -0,0 +1,35 @@
{*********************************************************}
{* FlashFiler: FF2 Converter Stringtable constants *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{String constants}
const
ffcverrZeroCommitFreq = $D1;
ffcverrFF1TableOpen = $D2;
ffcverrFF2TableCreate = $D3;

31
components/flashfiler/sourcelaz/convert/ffcvcnst.rc Normal file
View File

@ -0,0 +1,31 @@
/*********************************************************
* FlashFiler: FF2 Converter string table resource *
*********************************************************/
/* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */
FF_CONVERTER_STRINGS RCDATA FFCVCNST.SRM

BIN
components/flashfiler/sourcelaz/convert/ffcvcnst.res Normal file
View File

Binary file not shown.

BIN
components/flashfiler/sourcelaz/convert/ffcvcnst.srm Normal file
View File

Binary file not shown.

34
components/flashfiler/sourcelaz/convert/ffcvcnst.str Normal file
View File

@ -0,0 +1,34 @@
;*********************************************************
;* FlashFiler: FF2 Converter string table resource *
;*********************************************************
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
#include "FFCvCnst.INC"
ffcverrZeroCommitFreq, "CommitFrequency can not be set to 0"
ffcverrFF1TableOpen, "Unable to open the FlashFiler 1 table"
ffcverrFF2TableCreate, "%s"

Some files were not shown because too many files have changed in this diff Show More