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.