Przeglądaj źródła

* create also db dir

peter 25 lat temu
rodzic
commit
3749af47bf

+ 1 - 1
fcl/Makefile.fpc

@@ -4,7 +4,7 @@
 
 [targets]
 dirs=go32v2 linux win32 os2
-exampledirs=tests shedit/gtk
+exampledirs=tests db/tests shedit/gtk
 
 [install]
 examplesubdir=fcl

+ 5 - 8
fcl/db/Makefile.fpc

@@ -6,20 +6,17 @@
 units=db ddg_ds ddg_rec mysqldb
 examples=testds createds mtest tested
 
-[defaults]
-defaultcpu=i386
-
 [require]
 options=-S2
 packages=fcl mysql
 
+[install]
+unitsubdir=fcl
+packagename=fcl
+
 [dirs]
 fpcdir=../..
-targetdir=.
-
-[libs]
-libgcc=1
-
+targetdir=../$(OS_TARGET)
 
 [rules]
 db$(PPUEXT): db.pp fields.inc dataset.inc dbs.inc

+ 16 - 0
fcl/db/tests/Makefile.fpc

@@ -0,0 +1,16 @@
+#
+#   Makefile.fpc for TDataSet Tests
+#
+
+[targets]
+programs=testds createds mtest tested
+
+[require]
+options=-S2
+packages=fcl mysql
+
+[dirs]
+fpcdir=../../..
+
+[libs]
+libgcc=1

+ 91 - 0
fcl/db/tests/createds.pp

@@ -0,0 +1,91 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Creates a flat datafile for use with testds.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program createds;
+
+{$mode delphi}
+
+uses ddg_rec,sysutils;
+
+Type IndexFile = File Of Longint;
+
+Var F : TDDGDataFile;
+    I : Integer;
+    S : String;
+    L : IndexFile;
+    TableName : String;
+    IndexName : String;
+    ARec : TDDGData;
+
+begin
+  If ParamCount<>1 then
+    begin
+    Writeln('Usage: createds tablename');
+    Halt(1);
+    end;
+  TableName:=ChangeFileExt(paramstr(1),'.ddg');
+  IndexName:=ChangeFileExt(TableName,'.ddx');
+  Assign(F,TableName);
+  Rewrite(F);
+  For I:=1 to 100 do
+    begin
+    S:=Format('This is person %d.',[i]);
+    With Arec Do
+      begin
+      Name:=S;
+      height:=I*0.001;
+      LongField:=i*4;
+      ShoeSize:=I;
+      WordField:=i*2;
+      DateTimeField:=Now;
+      TimeField:=Time;
+      DateField:=Date;
+      Even:=(I mod 2) = 0
+      end;
+    Write(F,ARec);
+    end;
+  Close(F);
+  Assign(L,IndexName);
+  Rewrite(L);
+  For I:=0 to 100-1 do
+    Write(L,I);
+  Close(L);
+end.
+{
+  $Log$
+  Revision 1.1.2.1  2000-09-01 22:19:12  peter
+    * create also db dir
+
+  Revision 1.1  2000/07/13 06:31:27  michael
+  + Initial import
+
+  Revision 1.6  2000/01/07 01:24:32  peter
+    * updated copyright to 2000
+
+  Revision 1.5  2000/01/06 01:20:32  peter
+    * moved out of packages/ back to topdir
+
+  Revision 1.1  2000/01/03 19:33:05  peter
+    * moved to packages dir
+
+  Revision 1.3  1999/11/11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.2  1999/10/24 17:07:54  michael
+  + Added copyright header
+
+}

+ 203 - 0
fcl/db/tests/testds.pp

@@ -0,0 +1,203 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Tests the TDDGDataset component.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program testds;
+
+uses db,ddg_ds,sysutils;
+
+Procedure Log(Const Msg : String);
+begin
+  Writeln(Msg);
+end;
+
+Procedure DumpFieldDef(F : TfieldDef);
+
+begin
+  With F do
+    begin
+    Writeln ('Name              : ',Name);
+    Writeln ('FieldNo           : ',FieldNo);
+    Writeln ('Size              : ',Size);
+    Writeln ('FieldClass        : ',FieldClass.ClassName);
+    Writeln ('Required          : ',required);
+    Writeln ('Precision         : ',Precision);
+    Writeln ('DataType          : ',FieldTypeNames[DataType]);
+    Writeln ('InternalCalcField : ',Internalcalcfield);
+    end;
+end;
+
+Procedure DumpField(F : Tfield);
+
+begin
+  With F do
+    begin
+    writeln ('-------------------------------------');
+    Writeln ('FieldName : ',FieldName);
+    Writeln ('FieldNo   : ',FieldNo);
+    Writeln ('Index     : ',Index);
+    Writeln ('DataSize  : ',DataSize);
+    Writeln ('Size      : ',Size);
+    Writeln ('DataType  : ',FieldTypeNames[DataType]);
+    Writeln ('Class     : ',ClassName);
+    Writeln ('Required  : ',required);
+    Writeln ('ReadOnly  : ',ReadOnly);
+    Writeln ('Visible   : ',Visible);
+    end;
+end;
+
+Procedure DumpFieldData (F : TField);
+
+begin
+  With F Do
+    begin
+    Writeln ('Field     : ',FieldName);
+    Writeln ('Data type : ',FieldTypeNames[DataType]);
+    Writeln ('As String : ',Asstring);
+    Case Datatype of
+      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
+      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
+      ftFloat : Writeln ('As Float : ',AsFloat);
+      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
+    end;
+    end;
+end;
+
+Var
+  Data : TDDGdataset;
+  I,Count : longint;
+  Bookie : TBookMarkStr;
+
+Procedure ScrollForward;
+
+begin
+  Writeln ('Browsing Forward:');
+  Writeln ('------------------');
+  With Data do
+    While NOT EOF do
+      begin
+      Writeln ('================================================');
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Next;
+      end;
+end;
+
+Procedure ScrollBackWard;
+
+begin
+  Writeln ('Browsing Backward:');
+  Writeln ('-------------------');
+  With Data do
+    While NOT BOF do
+      begin
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Prior;
+      end;
+end;
+
+begin
+  if paramcount<>1 then
+    begin
+    Writeln ('Usage : testds tablename');
+    Halt(1);
+    end;
+  Log ('Creating Dataset');
+  Data:=TDDGDataset.Create(Nil);
+  With Data do
+    begin
+    Log('Setting Tablename');
+    TableName:=Paramstr(1);
+    Log('Opening Dataset');
+    Open;
+    Log('Dumping fielddefs : ');
+    Writeln ('Fielddefs count : ',FieldDefs.Count);
+    For I:=0 to FieldDefs.Count-1 do
+      DumpFieldDef(FieldDefs.Items[i]);
+    Writeln ('Fields count : ',FieldCount);
+    For I:=0 to FieldCount-1 do
+      DumpField(Fields[i]);
+    ScrollForward;
+    ScrollBackWard;
+    Writeln ('Going to last :');
+    writeln ('---------------');
+    Last;
+    ScrollBackWard;
+    ScrollForward;
+    Writeln ('Going to first:');
+    First;
+    Count:=0;
+    Writeln ('Browsing Forward:');
+    Writeln ('------------------');
+    With Data do
+      While NOT EOF do
+        begin
+        Inc(Count);
+        If Count=50 then
+          begin
+          Writeln ('Setting bookmark on record');
+          Bookie:=Bookmark;
+          Writeln ('Got data : "',Bookie,'"');
+          end;
+        For I:=0 to FieldCount-1 do
+          DumpFieldData(Fields[I]);
+        Next;
+        end;
+    Writeln ('Jumping to bookmark',Bookie);
+    BookMark:=Bookie;
+    Writeln ('Dumping Record : ');
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+    Next;
+    Writeln ('Dumping Next Record : ');
+    For I:=0 to FieldCount-1 do
+      DumpFieldData(Fields[I]);
+    Prior;
+    Prior;
+    Writeln ('Dumping Previous Record : ');
+    For I:=0 to FieldCount-1 do
+      DumpFieldData(Fields[I]);
+    Log('Closing Dataset');
+    Close;
+    Log('End.');
+    Free;
+    end;
+end.
+{
+  $Log$
+  Revision 1.1.2.1  2000-09-01 22:19:12  peter
+    * create also db dir
+
+  Revision 1.1  2000/07/13 06:31:28  michael
+  + Initial import
+
+  Revision 1.6  2000/01/07 01:24:32  peter
+    * updated copyright to 2000
+
+  Revision 1.5  2000/01/06 01:20:32  peter
+    * moved out of packages/ back to topdir
+
+  Revision 1.1  2000/01/03 19:33:06  peter
+    * moved to packages dir
+
+  Revision 1.3  1999/11/11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.2  1999/10/24 17:07:54  michael
+  + Added copyright header
+
+}

+ 270 - 0
fcl/db/tests/tested.pp

@@ -0,0 +1,270 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Tests the TDDGDataset component.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program testds;
+
+uses db,ddg_ds,sysutils;
+
+Procedure Log(Const Msg : String);
+begin
+  Writeln(Msg);
+end;
+
+Procedure DumpFieldDef(F : TfieldDef);
+
+begin
+  With F do
+    begin
+    Writeln ('Name              : ',Name);
+    Writeln ('FieldNo           : ',FieldNo);
+    Writeln ('Size              : ',Size);
+    Writeln ('FieldClass        : ',FieldClass.ClassName);
+    Writeln ('Required          : ',required);
+    Writeln ('Precision         : ',Precision);
+    Writeln ('DataType          : ',FieldTypeNames[DataType]);
+    Writeln ('InternalCalcField : ',Internalcalcfield);
+    end;
+end;
+
+Procedure DumpField(F : Tfield);
+
+begin
+  With F do
+    begin
+    writeln ('-------------------------------------');
+    Writeln ('FieldName : ',FieldName);
+    Writeln ('FieldNo   : ',FieldNo);
+    Writeln ('Index     : ',Index);
+    Writeln ('DataSize  : ',DataSize);
+    Writeln ('Size      : ',Size);
+    Writeln ('DataType  : ',FieldTypeNames[DataType]);
+    Writeln ('Class     : ',ClassName);
+    Writeln ('Required  : ',required);
+    Writeln ('ReadOnly  : ',ReadOnly);
+    Writeln ('Visible   : ',Visible);
+    end;
+end;
+
+Procedure DumpFieldData (F : TField);
+
+begin
+  With F Do
+    begin
+    Writeln ('Field     : ',FieldName);
+    Writeln ('Data type : ',FieldTypeNames[DataType]);
+    Writeln ('As String : ',Asstring);
+    Case Datatype of
+      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
+      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
+      ftFloat : Writeln ('As Float : ',AsFloat);
+      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
+    end;
+    end;
+end;
+
+procedure DumpFields (DS : TDataset);
+
+Var I : longint;
+
+begin
+  With DS do
+    begin
+    Writeln('Dumping fields');
+    For I:=0 to FieldCount-1 do
+      DumpFieldData(Fields[i]);
+    end;
+end;
+
+Var
+  Data : TDDGdataset;
+  I,Count : longint;
+  Bookie : TBookMarkStr;
+
+Procedure ScrollForward;
+
+begin
+  Writeln ('Browsing Forward:');
+  Writeln ('------------------');
+  With Data do
+    While NOT EOF do
+      begin
+      Writeln ('================================================');
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Next;
+      end;
+end;
+
+Procedure ScrollBackWard;
+
+begin
+  Writeln ('Browsing Backward:');
+  Writeln ('-------------------');
+  With Data do
+    While NOT BOF do
+      begin
+      For I:=0 to FieldCount-1 do
+        DumpFieldData(Fields[I]);
+      Prior;
+      end;
+end;
+
+begin
+  if paramcount<>1 then
+    begin
+    Writeln ('Usage : testds tablename');
+    Halt(1);
+    end;
+  Log ('Creating Dataset');
+  Data:=TDDGDataset.Create(Nil);
+  With Data do
+    begin
+    Log('Setting Tablename');
+    TableName:=Paramstr(1);
+    Log('Opening Dataset');
+    Open;
+    Log('Dumping fielddefs : ');
+    Writeln ('Fielddefs count : ',FieldDefs.Count);
+    For I:=0 to FieldDefs.Count-1 do
+      DumpFieldDef(FieldDefs.Items[i]);
+    Writeln ('Fields count : ',FieldCount);
+    For I:=0 to FieldCount-1 do
+      DumpField(Fields[i]);
+    ScrollForward;
+    ScrollBackWard;
+    Writeln ('Doing append');
+    writeln ('------------');
+    Append;
+    FieldByName('Name').AsString:='AppendName';
+    FieldByName('Height').AsFloat:=9.99E9;
+    FieldByName('LongField').AsLongInt:=999;
+    FieldByName('ShoeSize').AsLongInt:=999;
+    FieldByName('WordField').AsLongInt:=999;
+    FieldByName('BooleanField').AsBoolean:=False;
+    FieldByName('DateTimeField').AsDateTime:=Now;
+    FieldByName('DateField').AsDateTime:=Date;
+    FieldByName('TimeField').AsDateTime:=Time;
+    Writeln ('End of append, going to post');
+    Post;
+    DumpFields(Data);
+    Writeln ('Doing Last');
+    Writeln ('----------');
+    Last;
+    DumpFields(Data);
+    Writeln ('Doing Prior');
+    Writeln ('----------');
+    Prior;
+    DumpFields(Data);
+    Writeln ('Doing Insert at position 8');
+    writeln ('--------------------------');
+    first;
+    for I:=1 to 7 do
+      Next;
+    Insert;
+    FieldByName('Name').AsString:='Insertname';
+    FieldByName('Height').AsFloat:=8.99E8;
+    FieldByName('LongField').AsLongInt:=888;
+    FieldByName('ShoeSize').AsLongInt:=888;
+    FieldByName('WordField').AsLongInt:=888;
+    FieldByName('BooleanField').AsBoolean:=True;
+    FieldByName('DateTimeField').AsDateTime:=Now;
+    FieldByName('DateField').AsDateTime:=Date;
+    FieldByName('TimeField').AsDateTime:=Time;
+    Post;
+    Writeln ('Doing field dump');
+    writeln ('----------------');
+    DumpFields(Data);
+    Writeln ('Doing Prior');
+    Writeln ('-----------');
+    Prior;
+    DumpFields(Data);
+    Writeln ('Doing Next');
+    Writeln ('----------');
+    Next;
+    DumpFields(Data);
+    Writeln ('Doing Next');
+    Writeln ('----------');
+    Next;
+    DumpFields(Data);
+    Writeln ('Doing Edit at position 5');
+    writeln ('-------------------------');
+    first;
+    for I:=1 to 4 do
+      Next;
+    Edit;
+    FieldByName('Name').AsString:='Editname';
+    FieldByName('Height').AsFloat:=3.33E3;
+    FieldByName('LongField').AsLongInt:=333;
+    FieldByName('ShoeSize').AsLongInt:=333;
+    FieldByName('WordField').AsLongInt:=333;
+    FieldByName('BooleanField').AsBoolean:=False;
+    FieldByName('DateTimeField').AsDateTime:=Now;
+    FieldByName('DateField').AsDateTime:=Date;
+    FieldByName('TimeField').AsDateTime:=Time;
+    Post;
+    Writeln ('Doing field dump');
+    writeln ('----------------');
+    DumpFields(Data);
+    Writeln ('Doing Prior');
+    Writeln ('-----------');
+    Prior;
+    DumpFields(Data);
+    Writeln ('Doing Next');
+    Writeln ('----------');
+    Next;
+    DumpFields(Data);
+    Writeln ('Doing Next');
+    Writeln ('----------');
+    Next;
+    DumpFields(Data);
+    Writeln ('Closing.');
+    Close;
+    end;
+end.
+{
+  $Log$
+  Revision 1.1.2.1  2000-09-01 22:19:12  peter
+    * create also db dir
+
+  Revision 1.1  2000/07/13 06:31:28  michael
+  + Initial import
+
+  Revision 1.6  2000/01/07 01:24:32  peter
+    * updated copyright to 2000
+
+  Revision 1.5  2000/01/06 01:20:32  peter
+    * moved out of packages/ back to topdir
+
+  Revision 1.1  2000/01/03 19:33:06  peter
+    * moved to packages dir
+
+  Revision 1.3  1999/12/01 22:11:02  michael
+  + tested edit and insert methods
+
+  Revision 1.2  1999/12/01 10:11:58  michael
+  + test of insert works now
+
+  Revision 1.1  1999/11/14 19:26:17  michael
+  + Initial implementation
+
+  Revision 1.3  1999/11/11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.2  1999/10/24 17:07:54  michael
+  + Added copyright header
+
+}

+ 21 - 0
fcl/shedit/Makefile.fpc

@@ -0,0 +1,21 @@
+#
+#   Makefile.fpc for XML for FCL
+#
+
+[targets]
+units=doc_text shedit sh_xml sh_pas
+
+[require]
+options=-S2
+packages=fcl
+
+[install]
+unitsubdir=fcl
+packagename=fcl
+
+[dirs]
+fpcdir=../..
+targetdir=../$(OS_TARGET)
+
+[rules]
+vpath %$(PPUEXT) $(UNITTARGETDIR)

+ 18 - 0
fcl/xml/Makefile.fpc

@@ -0,0 +1,18 @@
+#
+#   Makefile.fpc for XML for FCL
+#
+
+[targets]
+units=dom htmldoc xmlcfg xmlread xmlstreaming xmlwrite
+
+[require]
+options=-S2
+packages=fcl
+
+[install]
+unitsubdir=fcl
+packagename=fcl
+
+[dirs]
+fpcdir=../..
+targetdir=../$(OS_TARGET)