1 | unit UDialingService;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
|
---|
7 | magrascon, magrasedt, ExtCtrls, UMainForm, magrasapi,
|
---|
8 | UTextFileStream, Registry;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TService1 = class(TService)
|
---|
12 | MagRasEdt1: TMagRasEdt;
|
---|
13 | MagRasCon1: TMagRasCon;
|
---|
14 | Timer1: TTimer;
|
---|
15 | Timer2: TTimer;
|
---|
16 | procedure ServiceExecute(Sender: TService);
|
---|
17 | procedure Timer1Timer(Sender: TObject);
|
---|
18 | procedure MagRasCon1StateChanged(Sender: TObject);
|
---|
19 | procedure ServiceStart(Sender: TService; var Started: Boolean);
|
---|
20 | procedure Timer2Timer(Sender: TObject);
|
---|
21 | procedure ServiceStop(Sender: TService; var Stopped: Boolean);
|
---|
22 | private
|
---|
23 | Connecting: Boolean;
|
---|
24 | DialHandle: Cardinal;
|
---|
25 | function GetLogFileEnabled: Boolean;
|
---|
26 | procedure SetLogFileEnabled(const Value: Boolean);
|
---|
27 | function GetLogFileName: string;
|
---|
28 | procedure SetLogFileName(const Value: string);
|
---|
29 | function GetConnectionName: string;
|
---|
30 | procedure SetConnectionName(const Value: string);
|
---|
31 | function GetLogClearOnStart: Boolean;
|
---|
32 | procedure SetLogClearOnStart(const Value: Boolean);
|
---|
33 | public
|
---|
34 | LastState: Word;
|
---|
35 |
|
---|
36 | procedure Dial;
|
---|
37 | procedure DialLog(Message: string);
|
---|
38 | function GetServiceController: TServiceController; override;
|
---|
39 | property LogFileEnabled: Boolean read GetLogFileEnabled
|
---|
40 | write SetLogFileEnabled;
|
---|
41 | property LogFileName: string read GetLogFileName
|
---|
42 | write SetLogFileName;
|
---|
43 | property ConnectionName: string read GetConnectionName
|
---|
44 | write SetConnectionName;
|
---|
45 | property LogClearOnStart: Boolean read GetLogClearOnStart
|
---|
46 | write SetLogClearOnStart;
|
---|
47 | end;
|
---|
48 |
|
---|
49 | var
|
---|
50 | Service1: TService1;
|
---|
51 |
|
---|
52 | implementation
|
---|
53 |
|
---|
54 | {$R *.DFM}
|
---|
55 |
|
---|
56 | procedure ServiceController(CtrlCode: DWord); stdcall;
|
---|
57 | begin
|
---|
58 | Service1.Controller(CtrlCode);
|
---|
59 | end;
|
---|
60 |
|
---|
61 | function TService1.GetServiceController: TServiceController;
|
---|
62 | begin
|
---|
63 | Result := ServiceController;
|
---|
64 | end;
|
---|
65 |
|
---|
66 | procedure TService1.ServiceExecute(Sender: TService);
|
---|
67 | begin
|
---|
68 | try
|
---|
69 | while not Terminated do begin
|
---|
70 | Sleep(1000);
|
---|
71 | //DialLog('.');
|
---|
72 | ServiceThread.ProcessRequests(True);
|
---|
73 | end;
|
---|
74 | finally
|
---|
75 | end;
|
---|
76 | DialLog('Konec');
|
---|
77 | end;
|
---|
78 |
|
---|
79 | procedure TService1.DialLog(Message: string);
|
---|
80 | var
|
---|
81 | LogFile: TTextFileStream;
|
---|
82 | begin
|
---|
83 | if LogFileEnabled then
|
---|
84 | try
|
---|
85 | if FileExists(LogFileName) then LogFile := TTextFileStream.Create(LogFileName, fmOpenReadWrite)
|
---|
86 | else LogFile := TTextFileStream.Create(LogFileName, fmCreate);
|
---|
87 | LogFile.Seek(0, soFromEnd);
|
---|
88 | LogFile.WriteLn(Message);
|
---|
89 | finally
|
---|
90 | LogFile.Free;
|
---|
91 | end;
|
---|
92 | end;
|
---|
93 |
|
---|
94 | procedure TService1.Dial;
|
---|
95 | var
|
---|
96 | I: Integer;
|
---|
97 | begin
|
---|
98 | if MagRasCon1.ConnectState = RASCS_Connected then
|
---|
99 | MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
|
---|
100 |
|
---|
101 | DialLog('');
|
---|
102 | DialLog(DateTimeToStr(Now) + ': Vytáèím pøípojení');
|
---|
103 | with MagRasCon1 do begin
|
---|
104 | GetConnections;
|
---|
105 | I := 0;
|
---|
106 | while (I < Connections.Count) and (Connections.EntryName(I) <> ConnectionName) do I := I + 1;
|
---|
107 | if not (I < Connections.Count) then begin
|
---|
108 | EntryName := ConnectionName;
|
---|
109 | PhoneNumber := '';
|
---|
110 | DialHandle := 0;
|
---|
111 | if AutoConnectEx(DialHandle) <> 0 then
|
---|
112 | DialLog('Dialling Failed - ' + MagRasCon1.StatusStr);
|
---|
113 | end;
|
---|
114 | end;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | procedure TService1.Timer1Timer(Sender: TObject);
|
---|
118 | begin
|
---|
119 | if MagRasCon1.ConnectState <> RASCS_Connected then begin
|
---|
120 | Timer1.Enabled := False;
|
---|
121 | Dial;
|
---|
122 | end;
|
---|
123 | end;
|
---|
124 |
|
---|
125 | function TService1.GetConnectionName: string;
|
---|
126 | begin
|
---|
127 | with TRegistry.Create do
|
---|
128 | try
|
---|
129 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
130 | OpenKey(RegistryPath, True);
|
---|
131 | if ValueExists('ConnectionName') then Result := ReadString('ConnectionName')
|
---|
132 | else Result := '';
|
---|
133 | finally
|
---|
134 | Free;
|
---|
135 | end;
|
---|
136 | end;
|
---|
137 |
|
---|
138 | procedure TService1.SetConnectionName(const Value: string);
|
---|
139 | begin
|
---|
140 | with TRegistry.Create do
|
---|
141 | try
|
---|
142 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
143 | OpenKey(RegistryPath, True);
|
---|
144 | WriteString('ConnectionName', Value)
|
---|
145 | finally
|
---|
146 | Free;
|
---|
147 | end;
|
---|
148 | end;
|
---|
149 |
|
---|
150 | function TService1.GetLogFileEnabled: Boolean;
|
---|
151 | begin
|
---|
152 | with TRegistry.Create do
|
---|
153 | try
|
---|
154 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
155 | OpenKey(RegistryPath, True);
|
---|
156 | if ValueExists('LogFileEnabled') then Result := ReadBool('LogFileEnabled')
|
---|
157 | else Result := False;
|
---|
158 | finally
|
---|
159 | Free;
|
---|
160 | end;
|
---|
161 | end;
|
---|
162 |
|
---|
163 | procedure TService1.SetLogFileEnabled(const Value: Boolean);
|
---|
164 | begin
|
---|
165 | with TRegistry.Create do
|
---|
166 | try
|
---|
167 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
168 | OpenKey(RegistryPath, True);
|
---|
169 | WriteBool('LogFileEnabled', Value)
|
---|
170 | finally
|
---|
171 | Free;
|
---|
172 | end;
|
---|
173 | end;
|
---|
174 |
|
---|
175 | function TService1.GetLogFileName: string;
|
---|
176 | begin
|
---|
177 | with TRegistry.Create do
|
---|
178 | try
|
---|
179 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
180 | OpenKey(RegistryPath, True);
|
---|
181 | if ValueExists('LogFileName') then Result := ReadString('LogFileName')
|
---|
182 | else Result := ApplicationDataFolder + '\' + DefaultLogFileName;
|
---|
183 | finally
|
---|
184 | Free;
|
---|
185 | end;
|
---|
186 | end;
|
---|
187 |
|
---|
188 | procedure TService1.SetLogFileName(const Value: string);
|
---|
189 | begin
|
---|
190 | with TRegistry.Create do
|
---|
191 | try
|
---|
192 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
193 | OpenKey(RegistryPath, True);
|
---|
194 | WriteString('LogFileName', Value)
|
---|
195 | finally
|
---|
196 | Free;
|
---|
197 | end;
|
---|
198 | end;
|
---|
199 |
|
---|
200 | procedure TService1.MagRasCon1StateChanged(Sender: TObject);
|
---|
201 | var
|
---|
202 | Info: string;
|
---|
203 | begin
|
---|
204 | if LastState = MagRasCon1.ConnectState then Exit;
|
---|
205 |
|
---|
206 | // check type of event
|
---|
207 | Info := '';
|
---|
208 | case MagRasCon1.StateEventSource of
|
---|
209 | SourceDial: Info := ' Dial: ';
|
---|
210 | SourceStatus: begin
|
---|
211 | Info := ' Status: ';
|
---|
212 | Timer1.Enabled := True;
|
---|
213 | end;
|
---|
214 | SourceHangup: Info := ' Hangup: ';
|
---|
215 | end;
|
---|
216 |
|
---|
217 | // see if new event, else display it
|
---|
218 | LastState := MagRasCon1.ConnectState ;
|
---|
219 | DialLog(Info + MagRasCon1.StatusStr
|
---|
220 | + ' (' + IntToStr(LastState) + ')');
|
---|
221 |
|
---|
222 | // if dialling need to see what's happened
|
---|
223 | if DialHandle <> 0 then begin
|
---|
224 | // online OK, restart timer
|
---|
225 | if (MagRasCon1.ConnectState = RASCS_Connected) then begin
|
---|
226 | // ConnHandle := DialHandle
|
---|
227 | // DialHandle := 0;
|
---|
228 | // TimerStatus.Enabled := True;
|
---|
229 | end;
|
---|
230 |
|
---|
231 | // dialling failed, either an error or disconnected
|
---|
232 | if ((MagRasCon1.ConnectState > RASBase) and
|
---|
233 | (MagRasCon1.ConnectState < RASCS_Paused)) or
|
---|
234 | (MagRasCon1.ConnectState = RASCS_Disconnected) then begin
|
---|
235 | // disconnect, returns when done or after three seconds, no StateChanged
|
---|
236 | //ConnHandle := DialHandle;
|
---|
237 | //DialHandle := 0;
|
---|
238 | MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
|
---|
239 | Timer1.Enabled := True;
|
---|
240 | // reset is done in timer event
|
---|
241 | end;
|
---|
242 | end;
|
---|
243 | end;
|
---|
244 |
|
---|
245 | procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
|
---|
246 | begin
|
---|
247 | Timer1.Enabled := True;
|
---|
248 | if LogClearOnStart and FileExists(LogFileName) then DeleteFile(LogFileName);
|
---|
249 | DialLog('Sluba sputìna v ' + DateTimeToStr(Now));
|
---|
250 | end;
|
---|
251 |
|
---|
252 | procedure TService1.Timer2Timer(Sender: TObject);
|
---|
253 | begin
|
---|
254 | MagRasCon1.CurrentStatusEx(DialHandle, 0);
|
---|
255 | end;
|
---|
256 |
|
---|
257 | function TService1.GetLogClearOnStart: Boolean;
|
---|
258 | begin
|
---|
259 | with TRegistry.Create do
|
---|
260 | try
|
---|
261 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
262 | OpenKey(RegistryPath, True);
|
---|
263 | if ValueExists('LogClearOnStart') then Result := ReadBool('LogClearOnStart')
|
---|
264 | else Result := False;
|
---|
265 | finally
|
---|
266 | Free;
|
---|
267 | end;
|
---|
268 | end;
|
---|
269 |
|
---|
270 | procedure TService1.SetLogClearOnStart(const Value: Boolean);
|
---|
271 | begin
|
---|
272 | with TRegistry.Create do
|
---|
273 | try
|
---|
274 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
275 | OpenKey(RegistryPath, True);
|
---|
276 | WriteBool('LogClearOnStart', Value)
|
---|
277 | finally
|
---|
278 | Free;
|
---|
279 | end;
|
---|
280 | end;
|
---|
281 |
|
---|
282 | procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
|
---|
283 | begin
|
---|
284 | DialLog('Sluba zastavena v ' + DateTimeToStr(Now));
|
---|
285 | end;
|
---|
286 |
|
---|
287 | end.
|
---|