Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "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        &#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 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.09.19;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.044 c
1-1094119866
Shurik_snz
2004-09-02 14:11
2004.09.19
Как в TTreeview изменить цвет текста узла?


3-1092844481
Aleksandr.
2004-08-18 19:54
2004.09.19
Объясните мне работу АДО-соединений, а то там фигня какая-то...


4-1091600613
Death_R
2004-08-04 10:23
2004.09.19
Cоздание кнопки На WinAPI


1-1094399416
ilnarab
2004-09-05 19:50
2004.09.19
Как поставить Таймер, чтобы он обновлял Caption?


14-1094036140
Real
2004-09-01 14:55
2004.09.19
Восстановление нормальной загрузки Win9x - Win2000 - Linux





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский