|
service application - что неправильно?
#32288172
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
|
|
|
|
честно говоря - сделал по шаблону с форума. но нифига не работает %)) ошибка 1053, служба не ответила на вопрос своевременно.
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.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
unit pr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, DB, SQLServer, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP;
type
TMyThread=class (TThread)
public
procedure Execute; override;
end;
Tinetprice = class(TService)
ss: TSQLServer;
ssType: TcsSQLQuery;
ssGood: TcsSQLQuery;
dsType: TDataSource;
dsGood: TDataSource;
ftp: TIdFTP;
procedure TimerTimer(Sender: TObject);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceExecute(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
end;
var
inetprice: Tinetprice;
MyThread:TMyThread;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
inetprice.Controller(CtrlCode);
end;
function Tinetprice.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure Tinetprice.TimerTimer(Sender: TObject);
var f : textfile;
begin
try
ss.Open;
ssType.Open;
ssGood.Open;
ssType.First;
assignfile(f, 'c:\price.dat');
rewrite(f);
closefile(f);
while not ssType.Eof do
begin
append(f);
writeln(f, '# ' + ssType.fieldbyname('tgt_type').value );
close(f);
ssGood.First;
while not ssGood.Eof do
begin
append(f);
writeln(f, '& ' + ssGood.fieldbyname('n').value );
writeln(f, '$ ' + ssGood.fieldbyname('pr').asstring );
writeln(f, '@ ' + ssGood.fieldbyname('cnd').value );
close(f);
ssGood.Next;
end;
ssType.Next;
end;
ftp.Connect();
ftp.put('c:\price.dat','www/data/price.dat');
ftp.Disconnect;
except
end;
end;
procedure Tinetprice.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
MyThread.Resume;
Continued:=true;
end;
procedure Tinetprice.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
MyThread.Terminate;
Stopped:=true;
end;
procedure Tinetprice.ServicePause(Sender: TService; var Paused: Boolean);
begin
MyThread.Suspend;
Paused:=true;
end;
procedure Tinetprice.ServiceStart(Sender: TService; var Started: Boolean);
begin
MyThread := TMyThread.Create(True);
MyThread.Priority:=tpNormal;
MyThread.Resume;
Started := True;
end;
procedure TMyThread.execute;
var f : textfile;
begin
try
with inetprice do
begin
ss.Open;
ssType.Open;
ssGood.Open;
ssType.First;
assignfile(f, 'c:\price.dat');
rewrite(f);
closefile(f);
while not ssType.Eof do
begin
append(f);
writeln(f, '# ' + ssType.fieldbyname('tgt_type').value );
close(f);
ssGood.First;
while not ssGood.Eof do
begin
append(f);
writeln(f, '& ' + ssGood.fieldbyname('n').value );
writeln(f, '$ ' + ssGood.fieldbyname('pr').asstring );
writeln(f, '@ ' + ssGood.fieldbyname('cnd').value );
close(f);
ssGood.Next;
end;
ssType.Next;
end;
ftp.Connect();
ftp.put('c:\price.dat','www/data/price.dat');
ftp.Disconnect;
end;
except
end;
end;
procedure Tinetprice.ServiceExecute(Sender: TService);
begin
MyThread.Execute;
end;
end.
|
|
|
