1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
program createusers;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, dbf, CustApp, db
{ you can add units after this };
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
private
procedure CreateUsers(DS: TDataset);
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ TMyApplication }
Type
TUserRecord = Record
L,N,E : string;
end;
Const
UserCount = 8;
Users : Array[1..UserCount] of TUserRecord = (
(L:'Daniel';N:'Daniel mantione'; E:'daniel@freepascal.org'),
(L:'Florian';N:'Florian Klaempfl'; E:'florian@freepascal.org'),
(L:'Joost';N:'Joost van der Sluis'; E:'joost@freepascal.org'),
(L:'Jonas';N:'Jonas Maebe'; E:'jonas@freepascal.org'),
(L:'Michael';N:'Michael van canneyt'; E:'michael@freepascal.org'),
(L:'Marco';N:'Marco Van De Voort'; E:'marco@freepascal.org'),
(L:'Pierre';N:'Pierre Muller'; E:'pierre@freepascal.org'),
(L:'Tomas';N:'Tomas Hajny'; E:'tomas@freepascal.org')
) ;
procedure TMyApplication.CreateUsers(DS : TDataset);
Var
I : integer;
begin
For I:=1 to UserCount do
begin
DS.Append;
DS.FieldByName('Login').AsString:=Users[i].L;
DS.FieldByName('Name').AsString:=Users[i].N;
DS.FieldByName('Email').AsString:=Users[i].E;
If Random(2)<1 then
DS.FieldByname('LastLogin').AsDatetime:=Date-Random(10);
DS.Post;
end;
end;
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
DB : TDBF;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
{ add your program here }
DB:=TDBF.Create(Self);
try
With DB.FieldDefs do
begin
Add('ID',ftAutoInc,0,True);
Add('Login',ftString,30,true);
Add('Name',ftString,50,True);
Add('Email',ftString,50,False);
Add('LastLogin',ftDate,0,False);
end;
DB.TableName:='users.dbf';
DB.TableLevel:=7;
DB.CreateTable;
DB.Open;
CreateUsers(DB);
finally
DB.Free;
end;
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMyApplication;
{$IFDEF WINDOWS}{$R createusers.rc}{$ENDIF}
{$R *.res}
begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.Run;
Application.Free;
end.
|
