← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to fcl/db/tests/mtest.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/tests/mtest.pp
1
 
{
2
 
    $Id: mtest.pp,v 1.1.2.1 2000/09/01 22:19:12 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by the Free Pascal development team
5
 
 
6
 
    <What does this file>
7
 
 
8
 
    See the file COPYING.FPC, included in this distribution,
9
 
    for details about the copyright.
10
 
 
11
 
    This program is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
 
 
15
 
 **********************************************************************}
16
 
program mtest;
17
 
 
18
 
uses db,sysutils,mysqldb;
19
 
 
20
 
Procedure Log(Const Msg : String);
21
 
begin
22
 
  Writeln(Msg);
23
 
end;
24
 
 
25
 
Procedure DumpFieldDef(F : TfieldDef);
26
 
 
27
 
begin
28
 
  With F do
29
 
    begin
30
 
    Writeln ('Name              : ',Name);
31
 
    Writeln ('FieldNo           : ',FieldNo);
32
 
    Writeln ('Size              : ',Size);
33
 
    Writeln ('FieldClass        : ',FieldClass.ClassName);
34
 
    Writeln ('Required          : ',required);
35
 
    Writeln ('Precision         : ',Precision);
36
 
    Writeln ('DataType          : ',FieldTypeNames[DataType]);
37
 
    Writeln ('InternalCalcField : ',Internalcalcfield);
38
 
    end;
39
 
end;
40
 
 
41
 
Procedure DumpField(F : Tfield);
42
 
 
43
 
begin
44
 
  With F do
45
 
    begin
46
 
    Writeln ('FieldName : ',FieldName);
47
 
    Writeln ('FieldNo   : ',FieldNo);
48
 
    Writeln ('Index     : ',Index);
49
 
    Writeln ('DataSize  : ',DataSize);
50
 
    Writeln ('Size      : ',Size);
51
 
    Writeln ('DataType  : ',FieldTypeNames[DataType]);
52
 
    Writeln ('Class     : ',ClassName);
53
 
    Writeln ('Required  : ',required);
54
 
    Writeln ('ReadOnly  : ',ReadOnly);
55
 
    Writeln ('Visible   : ',Visible);
56
 
    end;
57
 
end;
58
 
 
59
 
Procedure DumpFieldData (F : TField);
60
 
 
61
 
begin
62
 
  With F Do
63
 
    begin
64
 
    Writeln ('Field     : ',FieldName);
65
 
    Writeln ('Data type : ',FieldTypeNames[DataType]);
66
 
    Writeln ('As String : ',Asstring);
67
 
    Case Datatype of
68
 
      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
69
 
      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
70
 
      ftFloat : Writeln ('As Float : ',AsFloat);
71
 
      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
72
 
    end;
73
 
    end;
74
 
end;
75
 
 
76
 
Var
77
 
  Data : TMysqldataset;
78
 
  I,Count : longint;
79
 
  Bookie : TBookMarkStr;
80
 
 
81
 
Procedure ScrollForward;
82
 
 
83
 
begin
84
 
  Writeln ('Browsing Forward:');
85
 
  Writeln ('------------------');
86
 
  With Data do
87
 
    While NOT EOF do
88
 
      begin
89
 
      For I:=0 to FieldCount-1 do
90
 
        DumpFieldData(Fields[I]);
91
 
      Next;
92
 
      end;
93
 
end;
94
 
 
95
 
Procedure ScrollBackWard;
96
 
 
97
 
begin
98
 
  Writeln ('Browsing Backward:');
99
 
  Writeln ('-------------------');
100
 
  With Data do
101
 
    While NOT BOF do
102
 
      begin
103
 
      For I:=0 to FieldCount-1 do
104
 
        DumpFieldData(Fields[I]);
105
 
      Prior;
106
 
      end;
107
 
end;
108
 
 
109
 
begin
110
 
  if paramcount<>4 then
111
 
    begin
112
 
    Writeln ('Usage : mtest db user pwd sql');
113
 
    Halt(1);
114
 
    end;
115
 
  Log ('Creating Dataset');
116
 
  Data:=TMysqlDataset.Create(Nil);
117
 
  With Data do
118
 
    begin
119
 
    Log('Setting database');
120
 
    Database:=Paramstr(1);
121
 
    Log('Setting user');
122
 
    User:=Paramstr(2);
123
 
    Log('Setting password');
124
 
    PassWord := Paramstr(3);
125
 
    Log('Setting SQL');
126
 
    SQL.text := Paramstr(4);
127
 
    Log('Opening Dataset');
128
 
    Open;
129
 
    Log('Dumping fielddefs : ');
130
 
    Writeln ('Fielddefs count : ',FieldDefs.Count);
131
 
    For I:=0 to FieldDefs.Count-1 do
132
 
      DumpFieldDef(FieldDefs.Items[i]);
133
 
    Writeln ('Fields count : ',FieldCount);
134
 
    For I:=0 to FieldCount-1 do
135
 
      DumpField(Fields[i]);
136
 
    ScrollForward;
137
 
    ScrollBackWard;
138
 
    Writeln ('Going to last :');
139
 
    writeln ('---------------');
140
 
    Last;
141
 
    ScrollBackWard;
142
 
    ScrollForward;
143
 
    Writeln ('Going to first:');
144
 
    First;
145
 
    Count:=0;
146
 
    Writeln ('Browsing Forward:');
147
 
    Writeln ('------------------');
148
 
    With Data do
149
 
      While NOT EOF do
150
 
        begin
151
 
        Inc(Count);
152
 
        If Count=recordCount div 2 then
153
 
          begin
154
 
          Writeln ('Setting bookmark on record');
155
 
          Bookie:=Bookmark;
156
 
          Writeln ('Got data : "',Bookie,'"');
157
 
          end;
158
 
        For I:=0 to FieldCount-1 do
159
 
          DumpFieldData(Fields[I]);
160
 
        Next;
161
 
        end;
162
 
    Writeln ('Jumping to bookmark',Bookie);
163
 
    BookMark:=Bookie;
164
 
    Writeln ('Dumping Record : ');
165
 
      For I:=0 to FieldCount-1 do
166
 
        DumpFieldData(Fields[I]);
167
 
    Next;
168
 
    Writeln ('Dumping Next Record : ');
169
 
    For I:=0 to FieldCount-1 do
170
 
      DumpFieldData(Fields[I]);
171
 
    Prior;
172
 
    Prior;
173
 
    Writeln ('Dumping Previous Record : ');
174
 
    For I:=0 to FieldCount-1 do
175
 
      DumpFieldData(Fields[I]);
176
 
    Log('Closing Dataset');
177
 
    Close;
178
 
    Log('End.');
179
 
    Free;
180
 
    end;
181
 
end.
182
 
 
183
 
{
184
 
   $Log: mtest.pp,v $
185
 
   Revision 1.1.2.1  2000/09/01 22:19:12  peter
186
 
     * create also db dir
187
 
 
188
 
   Revision 1.1  2000/07/13 06:31:27  michael
189
 
   + Initial import
190
 
 
191
 
   Revision 1.5  2000/01/07 01:24:32  peter
192
 
     * updated copyright to 2000
193
 
 
194
 
   Revision 1.4  2000/01/06 01:20:32  peter
195
 
     * moved out of packages/ back to topdir
196
 
 
197
 
   Revision 1.1  2000/01/03 19:33:06  peter
198
 
     * moved to packages dir
199
 
 
200
 
   Revision 1.2  1999/10/24 17:07:54  michael
201
 
   + Added copyright header
202
 
 
203
 
}
 
 
b'\\ No newline at end of file'