Текущий архив: 2004.09.19;
Скачать: CL | DM;

Вниз

Ошибка при создании сервиса   Найти похожие ветки 

← →
CAMCOH ©   (2004-08-02 16:25) [0]

Есть программка которая как это ни странно работает :)
И вот появилась необходимость сделать чтобы она была сервисом.
Для этого делаю File->New->Other->Service application

И копирую необходимые части программы таким образом что получается Unit1

Сервис запускается и висит в памяти но то что от него требуется он неделает...
Подскажите в чём ошибка пожалуйста....


unit Unit1;

interface

uses
 windows, messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, ExtCtrls, IdUDPServer, IdBaseComponent,
 IdComponent, IdUDPBase, IdUDPClient, Types, Variants,  Forms,
 idSocketHandle, QExtCtrls, QStdCtrls, QControls,
 StdCtrls, registry, clipbrd, winsock;

const tinterv=60; // vremja ozhidanija signala v sekundah. posle etogo vremeni blok
type
 TService6 = class(TService)
   Timer1: TTimer;
   Timer2: TTimer;
   Timer3: TTimer;
   IdUDPServer1: TIdUDPServer;
   IdUDPClient1: TIdUDPClient;
   procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
     ABinding: TIdSocketHandle);
   procedure Timer1Timer(Sender: TObject);
   procedure Timer2Timer(Sender: TObject);
   procedure Timer3Timer(Sender: TObject);
   procedure ServiceStart(Sender: TService; var Started: Boolean);
 private
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;

var
 Service6: TService6;
 i: Integer;
 movingstring,movingstring2: string;
 VisibleSymbols:integer;
implementation

{$R *.DFM}

procedure WriteDC(s: string);
var
 c: TCanvas;
begin
 c := TCanvas.Create;
 c.Brush.Color := clBlack;
 c.Font.color := clRed;
 c.Font.size := 25;
 c.Font.name := "Fixedsys";
 c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
 c.TextOut(0,0, s);
 c.free;
end;

procedure BlockInput; external "user32.dll";

procedure Block;
asm
 push 1
 call BlockInput
end;

procedure UnBlock;
asm
 push 0
 call BlockInput
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
 Service6.Controller(CtrlCode);
end;

function TService6.GetServiceController: TServiceController;
begin
 Result := ServiceController;
end;

procedure TService6.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
 ABinding: TIdSocketHandle);
var
 StringFormatedStream: TStringStream;
 s: String;
 n:integer;

begin
// Skipped
end;

procedure TService6.Timer1Timer(Sender: TObject);
begin
timer1.Interval:=2000;
block;
end;

procedure TService6.Timer2Timer(Sender: TObject);
begin
writedc(Copy(MovingString2, i, VisibleSymbols));
Inc(i);
if Length(MovingString2) - VisibleSymbols < i then
timer2.Enabled:=false;
end;

procedure TService6.Timer3Timer(Sender: TObject);
var WSAData : TWSAData;
p : PHostEnt;
s:string;
Name : array [0..$FF] of Char;
begin
showmessage("start wlogon1");
WSAStartup($0101, WSAData);
GetHostName(name, $FF);
p := GetHostByName(Name);
idudpclient1.Active:=true;
IdUDPClient1.Host:="62.85.75.40" ;
s:="p"+inet_ntoa(PInAddr(p.h_addr_list^)^);
IdUDPClient1.Send(s);
WSACleanup;
end;

procedure TService6.ServiceStart(Sender: TService; var Started: Boolean);
var n:integer;
begin
timer1.Interval:=tinterv*1000;

 timer2.Enabled:=true;
 MovingString := "Jums ir 10 minutes        &#206;&#241;&#242;&#224;&#235;&#238;&#241;&#252; 10 &#236;&#232;&#237;&#243;&#242;        You have 10 minutes";
 VisibleSymbols:= (screen.Width div 20)+20;
 for n:=0 to (screen.Width div 20)+1 do movingstring2:=movingstring2+" ";
 movingstring2:= movingstring2+movingstring;
 for n:=0 to (screen.Width div 20)+30 do movingstring2:=movingstring2+" ";
 writedc(Copy(MovingString2, i, VisibleSymbols));
 Inc(i);
 if Length(MovingString2) - VisibleSymbols < i then
 timer2.Enabled:=false;

end;
end.



---

← →
CAMCOH ©   (2004-08-03 00:02) [1]

Nju chto neuzheli nikto nemozhe podskazat" s etim delom ?

---

← →
Slym ©   (2004-08-03 04:16) [2]

Таймеры! Похерь их!

---

Страницы: 1 вся ветка

Текущий архив: 2004.09.19;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.049 c