Форум: "WinAPI";
Текущий архив: 2004.09.19;
Скачать: [xml.tar.bz2];
Вниз
Ошибка при создании сервиса Найти похожие ветки
← →
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 Îñòàëîñü 10 ìèíóò 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 вся ветка
Форум: "WinAPI";
Текущий архив: 2004.09.19;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.03 c
