Главная страница
    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.038 c
1-1094040128
nastya
2004-09-01 16:02
2004.09.19
Глюки с COM-портом. Помогите!!!!


1-1093960037
DimonNew
2004-08-31 17:47
2004.09.19
передача массива в процедуру


1-1094395391
ZLG
2004-09-05 18:43
2004.09.19
Какой функцией определить диск и каталоги к запускаемому файлу


1-1094187578
Anhonio
2004-09-03 08:59
2004.09.19
Delphi &amp; Scaner


1-1093949185
tria
2004-08-31 14:46
2004.09.19
лишнее событие от мыши





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский