Trade Show trick of the Trade Show

Prev: normality in sd product
Next: c/(1+c) < a/(1+a) + b/(1+b)

From: Exploit me. on 29 Mar 2010 13:17

---

program RealTimeSave;

uses
Forms,
uRealTimeSave1 in 'uRealTimeSave1.pas' {Form1},
uKbmRTS in 'uKbmRTS.pas';

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
unit uKbmRTS;

interface

uses
SysUtils, Classes, Db, kbmMemTable, kbmMemCSVStreamFormat;

const
KBM_RTS_VERSION = '0.01';

type
TKbmRTS = class(TObject)
private
FRefField: TField;
FMTSource: TKbmMemTable;
FMTDest: TKbmMemTable;
FPersistentFile: string;
FCSV: TKbmCSVStreamFormat;
FRecSize: integer;
FBlankLine: string;
FFileStream: TFileStream;
FMemStream: TMemoryStream;
FVersion: string;
Floading: boolean;
procedure SetRecSize(const Value: integer);
procedure InternalSaveRecord(Header: boolean);
procedure SetVersion(const Value: string);
procedure CheckFileStream(KeepOpen: boolean);
public
constructor Create;
destructor Destroy; override;
procedure CloseFile;
procedure DeleteRecord;
procedure LoadFromFile;
procedure SaveRecord;
property RefField: TField read FRefField write FRefField;
property MTSource: TKbmMemTable read FMTSource write FMTSource;
property PersistentFile: string read FPersistentFile write
FPersistentFile;
property RecSize: integer read FRecSize write SetRecSize;
property Version: string read FVersion write SetVersion;
end;

implementation

{ TKbmRTS }

constructor TKbmRTS.Create;
begin
inherited;
FMTSource := TKbmMemTable.Create(nil);
FCSV := TKbmCSVStreamFormat.Create(nil);
FMemStream := TMemoryStream.Create;
FMTDest := TKbmMemTable.Create(nil);

FCSV.sfDef := [];
FCSV.sfFieldKind := [];
FCSV.sfIndexDef := [];
end;

destructor TKbmRTS.Destroy;
begin
FMTSource.Free;
FCSV.Free;
FFileStream.Free;
FMemStream.Free;
FMTDest.Free;
inherited;
end;

procedure TKbmRTS.SetVersion(const Value: string);
begin
end;

procedure TKbmRTS.InternalSaveRecord(Header: boolean);
var
Offset, Size: integer;
begin
if not FMTDest.Active then begin
FMTDest.CreateTableAs(FMTSource, [mtcpoStructure]);
FMTDest.Open;
FMTDest.DefaultFormat := FCSV;
end;

if not Header then
FMTDest.CopyRecords(FMTSource, FMTDest, 1);

FMemStream.Clear;
FMTDest.SaveToStream(FMemStream);
FMTDest.EmptyTable;

if Header then
Offset := 0
else
Offset := (FRefField.Value + 1) * FRecSize;

Size := FRecSize - 2;
while FFileStream.Size < Offset do begin
FFileStream.Seek(0, soFromEnd);
FFileStream.Write(FBlankLine[1], Size);
FFileStream.Write(#13#10[1], 2);
end;

FFileStream.Seek(Offset, soFromBeginning);
Size := FMemStream.Size - 2;
FFileStream.Write(FMemStream.Memory^, Size);
FFileStream.Write(FBlankLine[1], FRecSize - Size - 2);
FFileStream.Write(#13#10[1], 2);
end;

procedure TKbmRTS.DeleteRecord;
var
Offset: integer;
begin
if FLoading then
Exit;

CheckFileStream(True);
Offset := (FRefField.Value + 1) * FRecSize;
FFileStream.Seek(Offset, soFromBeginning);
FFileStream.Write(FBlankLine[1], FRecSize - 2);
FFileStream.Write(#13#10[1], 2);
end;

procedure TKbmRTS.LoadFromFile;
begin
if FLoading then
Exit;

FLoading := True;
try
CheckFileStream(False);
FMTSource.DefaultFormat := FCSV;
FMTSource.LoadFromFile(FPersistentFile);
FMTSource.First;
while not FMTSource.Eof do
if FRefField.IsNull then
FMTSource.Delete
else
FMTSource.Next;
finally
FLoading := False;
end;
end;

procedure TKbmRTS.SaveRecord;
begin
if FLoading then
Exit;

CheckFileStream(True);
InternalSaveRecord(False);
end;

procedure TKbmRTS.SetRecSize(const Value: integer);
begin
if Value = FRecSize then
Exit;

FRecSize := Value;
SetLength(FBlankLine, FRecSize);
FillChar(FBlankLine[1], FRecSize, ',');
end;

procedure TKbmRTS.CheckFileStream(KeepOpen: boolean);
begin
if Assigned(FFileStream) then begin
if not KeepOpen then begin
FFileStream.Free;
FFileStream := nil;
end;
Exit;
end;

if not FileExists(FPersistentFile) then begin
FCSV.sfNoHeader := [];
FFileStream := TFileStream.Create(FPersistentFile, fmCreate);
InternalSaveRecord(True);
FFileStream.Free;
FFileStream := nil;
end;
FCSV.sfNoHeader := [sfSaveNoHeader];
if KeepOpen then
FFileStream := TFileStream.Create(FPersistentFile,
fmOpenReadWrite or fmShareDenyNone);
end;

procedure TKbmRTS.CloseFile;
begin
if not Assigned(FFileStream) then
Exit;

FFileStream.Free;
FFileStream := nil;
end;

end.
ÿ
TFORM1 0î TPF0TForm1Form1LeftÀ TopkWidth}

Height‚CaptionForm1Color clBtnFace
Font.CharsetDEFAULT_CHARSET
Font.ColorclWindowTextFont.Heightõ Font.Name
MS Sans Serif
Font.Style OldCreateOrderOnCloseQueryFormCloseQueryOnCreate
FormCreate
PixelsPerInch`
TextHeight
TDBGridDBGridLeft Top Widthu
Height>AlignalClient
DataSourceDSOptionsdgTitlesdgIndicatordgColumnResize
dgColLines
dgRowLinesdgTabsdgRowSelectdgConfirmDeletedgCancelOnExit
ReadOnly TabOrder
TitleFont.CharsetDEFAULT_CHARSETTitleFont.Color
clWindowTextTitleFont.HeightõTitleFont.Name
MS Sans SerifTitleFont.Style TPanelPanel1Left
Top>Widthu
Height)AlignalBottomTabOrder

TButtonDelBtnLefthTopWidthKHeightCaptionDelBtnTabOrder
OnClickDelBtnClick TButton
AddDataBtnLeftTopWidthKHeightCaption
AddDataBtnTabOrder
OnClickAddDataBtnClick TButton
ChangeBtnLeftÀ TopWidthKHeightCaption
ChangeBtnTabOrderOnClickChangeBtnClick
TDataSourceDSDataSetMTLeftHTop8
TkbmMemTableMTDesignActivation AttachedAutoRefresh 
AttachMaxCount
FieldDefs IndexDefs SortOptions
PersistentBackup
ProgressFlagsmtpcLoadmtpcSavemtpcCopy
FilterOptions Version4.04
LanguageID SortID
SubLanguageID
LocaleID  AfterPostMTAfterPost
BeforeDeleteMTBeforeDeleteLeftpTop8
TAutoIncFieldMTRef FieldNameRef TStringFieldMTData
FieldNameData
TkbmCSVStreamFormatCSVCSVQuote
"CSVFieldDelimiter
,CSVRecordDelimiter
,
CSVTrueStringTrueCSVFalseStringFalse
sfLocalFormat sfQuoteOnlyStrings
sfNoHeader Version3.00sfData
sfSaveData
sfLoadData sfCalculated sfLookup sfNonVisible
sfSaveNonVisiblesfLoadNonVisible sfBlobssfSaveBlobssfLoadBlobs
sfDef
sfIndexDef sfPlaceHolders
sfFilteredsfSaveFiltered
sfIgnoreRangesfSaveIgnoreRange sfIgnoreMasterDetail
sfSaveIgnoreMasterDetail sfDeltas sfDontFilterDeltas sfAppend
sfFieldKind sfFromStartsfLoadFromStart Left˜ Top8 unit
uRealTimeSave1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
kbmMemTable, kbmMemCSVStreamFormat, Db, ExtCtrls, Grids, DBGrids,
uKbmRts,
StdCtrls;

type
TForm1 = class(TForm)
DS: TDataSource;
MT: TkbmMemTable;
DBGrid: TDBGrid;
MTRef: TAutoIncField;
MTData: TStringField;
CSV: TkbmCSVStreamFormat;
Panel1: TPanel;
DelBtn: TButton;
AddDataBtn: TButton;
ChangeBtn: TButton;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure DelBtnClick(Sender: TObject);
procedure AddDataBtnClick(Sender: TObject);
procedure ChangeBtnClick(Sender: TObject);
procedure MTBeforeDelete(DataSet: TDataSet);
procedure MTAfterPost(DataSet: TDataSet);
private
MTRTS: TKbmRTS;
public
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
MT.Open;
MTRTS := TKbmRTS.Create;
MTRTS.MTSource := MT;
MTRTS.RefField := MTRef;
MTRTS.RecSize := 50;
MTRTS.PersistentFile := ExtractFilePath(Application.ExeName) +
'MTData.csv';
MTRTS.LoadFromFile;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);
begin
MTRTS.Free;
end;

procedure TForm1.AddDataBtnClick(Sender: TObject);
begin
MT.Append;
MTData.AsDateTime := Now;
MT.Post;
end;

procedure TForm1.DelBtnClick(Sender: TObject);
begin
MT.Delete;
end;

procedure TForm1.ChangeBtnClick(Sender: TObject);
begin
MT.Edit;
MTData.AsDateTime := Now;
MT.Post;
end;

procedure TForm1.MTBeforeDelete(DataSet: TDataSet);
begin
MTRTS.DeleteRecord;
end;

procedure TForm1.MTAfterPost(DataSet: TDataSet);
begin
MTRTS.SaveRecord;
end;

end.

 | 
Pages: 1
Prev: normality in sd product
Next: c/(1+c) < a/(1+a) + b/(1+b)