1 (*
2 ***************************************************************************
3 * *
4 * This program is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License. *
7 * *
8 ***************************************************************************
9 *)
10
11
12 unit fDXCluster;
13
14 {$mode objfpc}{$H+}
15
16 interface
17
18 uses
19 Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, inifiles,
20 ExtCtrls, ComCtrls, StdCtrls, Buttons, httpsend, uColorMemo,
21 db, lcltype, Menus, ActnList, Spin, dynlibs, lNetComponents, lnet;
22
23 type
24 { TfrmDXCluster }
25
26 TfrmDXCluster = class(TForm)
27 acPreferences : TActionList;
28 acFont : TAction;
29 acCallAlert : TAction;
30 acProgPref : TAction;
31 acChatSize: TAction;
32 btnClear: TButton;
33 btnFont: TButton;
34 btnHelp: TButton;
35 btnSelect: TButton;
36 btnTelConnect: TButton;
37 btnWebConnect: TButton;
38 Button1: TButton;
39 Button2: TButton;
40 btnPreferences : TButton;
41 dlgDXfnt: TFontDialog;
42 edtCommand: TEdit;
43 edtTelAddress: TEdit;
44 Label1: TLabel;
45 lblInfo: TLabel;
46 MenuItem1 : TMenuItem;
47 mnuSkimQSLCheck: TMenuItem;
48 MenuItem2 : TMenuItem;
49 MenuItem3 : TMenuItem;
50 MenuItem4 : TMenuItem;
51 MenuItem5 : TMenuItem;
52 MenuItem6: TMenuItem;
53 MenuItem7: TMenuItem;
54 MenuItem8: TMenuItem;
55 mnuSkimAllowFreq: TMenuItem;
56 mnuCallalert : TMenuItem;
57 Panel1: TPanel;
58 Panel2: TPanel;
59 pnlChat: TPanel;
60 Panel4: TPanel;
61 pgDXCluster: TPageControl;
62 pnlTelnet: TPanel;
63 pnlWeb: TPanel;
64 popPreferences : TPopupMenu;
65 tabTelnet: TTabSheet;
66 tabWeb: TTabSheet;
67 tmrAutoConnect: TTimer;
68 tmrSpots: TTimer;
69 trChatSize: TTrackBar;
70 procedure acCallAlertExecute(Sender : TObject);
71 procedure acChatSizeExecute(Sender: TObject);
72 procedure acFontExecute(Sender : TObject);
73 procedure acProgPrefExecute(Sender : TObject);
74 procedure Button2Click(Sender: TObject);
75 procedure btnPreferencesClick(Sender : TObject);
76 procedure FormActivate(Sender: TObject);
77 procedure FormDestroy(Sender: TObject);
78 procedure btnHelpClick(Sender: TObject);
79 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
80 procedure FormCreate(Sender: TObject);
81 procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
82 procedure FormShow(Sender: TObject);
83 procedure btnClearClick(Sender: TObject);
84 procedure btnSelectClick(Sender: TObject);
85 procedure btnTelConnectClick(Sender: TObject);
86 procedure btnWebConnectClick(Sender: TObject);
87 procedure edtCommandKeyPress(Sender: TObject; var Key: char);
88 procedure mnuCallalertClick(Sender : TObject);
89 procedure mnuSkimAllowFreqClick(Sender: TObject);
90 procedure mnuSkimQSLCheckClick(Sender: TObject);
91 procedure tmrAutoConnectTimer(Sender: TObject);
92 procedure tmrSpotsTimer(Sender: TObject);
93 procedure trChatSizeChange(Sender: TObject);
94 procedure trChatSizeClick(Sender: TObject);
95 private
96 telDesc : String;
97 telAddr : String;
98 telPort : String;
99 telUser : String;
100 telPass : String;
101 Running : Boolean;
102 FirstShow : Boolean;
103 ConOnShow : Boolean;
104 lTelnet : TLTelnetClientComponent;
105 csDXCPref : TRTLCriticalSection;
106 ReloadDXCPref : Boolean;
107 FirstWebGet : Boolean;
108
109 gcfgUseBackColor : Boolean;
110 gcfgBckColor : TColor;
111 gcfgeUseBackColor : Boolean;
112 gcfgeBckColor : TColor;
113 gcfgiDXCC : String;
114 gcfgwIOTA : Boolean;
115 gcfgNewCountryColor : TColor;
116 gcfgNewBandColor : TColor;
117 gcfgNewModeColor : TColor;
118 gcfgNeedQSLColor : TColor;
119 gcfgShowFrom : Integer;
120 gcfgLastSpots : String;
121 gcfgIgnoreBandFreq : Boolean;
122 gcfgUseDXCColors : Boolean;
123 gcfgClusterColor : TColor;
124 gcfgNotShow : String;
125 gcfgCW : Boolean;
126 gcfgSSB : Boolean;
127 gcfgEU : Boolean;
128 gcfgAS : Boolean;
129 gcfgAF : Boolean;
130 gcfgNA : Boolean;
131 gcfgSA : Boolean;
132 gcfgAN : Boolean;
133 gcfgOC : Boolean;
134 gwDXCC : String;
135 gwWAZ : String;
136 gwITU : String;
137 giDXCC : String;
138 giWAZ : String;
139 giITU : String;
140
141 HistCmd : array [0..4] of string;
142 HistPtr : integer;
143
144 procedure WebDbClick(where:longint;mb:TmouseButton;ms:TShiftState);
145 procedure TelDbClick(where:longint;mb:TmouseButton;ms:TShiftState);
146 procedure ConnectToWeb;
147 procedure ConnectToTelnet;
148 procedure SynWeb;
149 procedure SynTelnet;
150 procedure SynChat;
151 procedure lConnect(aSocket: TLSocket);
152 procedure lDisconnect(aSocket: TLSocket);
153 procedure lReceive(aSocket: TLSocket);
154 procedure ChangeCallAlertCaption;
155
ShowSpotnull156 function ShowSpot(spot : String; var sColor : Integer; var Country : String; FromTelnet : Boolean = True) : Boolean;
GetFreqnull157 function GetFreq(spot : String) : String;
GetCallnull158 function GetCall(spot : String; web : Boolean = False) : String;
GetSplitnull159 function GetSplit(spot : String) :String;
160 procedure StoreLastCmd(LastCmd:string);
GetHistCmdnull161 function GetHistCmd:string;
162 public
163 ConWeb : Boolean;
164 ConTelnet : Boolean;
165 csTelnet : TRTLCriticalSection;
166
167 procedure SendCommand(cmd : String);
168 procedure StopAllConnections;
169 procedure ReloadSettings;
170 end;
171
172 type
173 TWebThread = class(TThread)
174 protected
175 BiggerFetch : Boolean;
176 procedure Execute; override;
177 end;
178
179 type
180 TTelThread = class(TThread)
181 protected
182 procedure Execute; override;
183 end;
184
185 var
186 frmDXCluster : TfrmDXCluster;
187 Spots : TStringList;
188 Chats : TStringList;
189 WebSpots : TColorMemo;
190 TelSpots : TColorMemo;
191 ChatSpots : TColorMemo;
192 mindex : Integer;
193 ThInfo : String;
194 ThSpot : String;
195 ThColor : Integer;
196 ThBckColor : Integer;
197 ThChat : String;
198 ChBckColor : Integer;
199 TelThread : TTelThread;
200 SentStartCmd : Boolean;
201
202 implementation
203 {$R *.lfm}
204 { TfrmDXCluster }
205
206 uses dUtils, fDXClusterList, dData, dDXCluster, fMain, fTRXControl, fNewQSO, fBandMap,
207 uMyIni, fPreferences;
208
209 procedure TfrmDXCluster.ConnectToWeb;
210 var
211 WebThread : TWebThread = nil;
212 begin
213 tmrSpots.Enabled := True;
214 if not Running then
215 begin
216 Running := True;
217 if dmData.DebugLevel>=1 then
218 Writeln('In ConnectWeb');
219 if WebThread = nil then
220 begin
221 WebThread := TWebThread.Create(True);
222 WebThread.FreeOnTerminate := True
223 end;
224 WebThread.BiggerFetch := FirstWebGet;
225 WebThread.Start;
226 FirstWebGet := False
227 end
228 end;
229
230 procedure TfrmDXCluster.ConnectToTelnet;
231 begin
232 if edtTelAddress.Text='' then
233 exit;
234 if ConTelnet then
235 begin
236 btnTelConnect.Caption := 'Connect';
237 StopAllConnections;
238 ConTelnet := False;
239 exit
240 end;
241 try
242 lTelnet.Host := telAddr;
243 lTelnet.Port := StrToInt(telPort);
244 lTelnet.Connect;
245 lTelnet.CallAction;
246 except
247 on E : Exception do
248 begin
249 Application.MessageBox(Pchar('Cannot connect to telnet!:'+#13+'Error: '+E.Message),'Error!',mb_ok+mb_IconError)
250 end
251 end;
252
253 if lTelnet.Connected then
254 begin
255 edtCommand.SetFocus;
256 btnTelConnect.Caption := 'Disconnect';
257 ConTelnet := True
258 end
259 end;
260
261 procedure TfrmDXCluster.FormClose(Sender: TObject; var CloseAction: TCloseAction
262 );
263 begin
264 if not Assigned(cqrini) then
265 exit;
266 dmUtils.SaveWindowPos(frmDXCluster);
267 cqrini.WriteInteger('DXCluster','Tab',pgDXCluster.ActivePageIndex);
268 cqrini.WriteString('DXCluster','Desc',telDesc);
269 cqrini.WriteString('DXCluster','Addr',telAddr);
270 cqrini.WriteString('DXCluster','Port',telPort);
271 cqrini.WriteString('DXCluster','User',telUser);
272 cqrini.WriteString('DXCluster','Pass',telPass);
273 cqrini.SaveToDisk;
274 if ConWeb then
275 btnWebConnect.Click;
276 if ConTelnet then
277 btnTelConnect.Click;
278 tmrSpots.Enabled := False;
279 end;
280 procedure TfrmDXCluster.StoreLastCmd(LastCmd:string); //scroll &store last typed line
281
282 begin
283 HistPtr:=4;
284 Repeat
285 Begin
286 HistCmd[HistPtr] := HistCmd[HistPtr-1];
287 if dmData.DebugLevel>=1 then writeln('[',HistPtr,']' ,HistCmd[HistPtr]);
288 dec(HistPtr);
289 end;
290 until HistPtr = 0;
291 HistCmd[HistPtr] := LastCmd;
292
293 if dmData.DebugLevel>=1 then writeln('[',HistPtr,']' ,HistCmd[HistPtr]);
294
295 end;
GetHistCmdnull296 function TfrmDXCluster.GetHistCmd:string; //return line that ptr points & inc ptr(go round if not empty);
297 begin
298 Result:= HistCmd[HistPtr];
299 if (HistPtr < 4) and ( HistCmd[HistPtr+1]<>'') then
300 inc (HistPtr)
301 else
302 HistPtr:=0;
303 end;
304
305
306
307 procedure TfrmDXCluster.btnHelpClick(Sender: TObject);
308 begin
309 ShowHelp
310 end;
311
312 procedure TfrmDXCluster.FormDestroy(Sender: TObject);
313 begin
314 if dmData.DebugLevel>=1 then Writeln('Closing DXCluster window');
315 TelThread.Terminate;
316 WebSpots.Free;
317 TelSpots.Free
318 end;
319
320 procedure TfrmDXCluster.FormActivate(Sender: TObject);
321 begin
322 if FirstShow and ConOnShow then
323 begin
324 btnTelConnect.Click;
325 FirstShow := False;
326 end;
327 end;
328
329 procedure TfrmDXCluster.Button2Click(Sender: TObject);
330 var
331 TelThread : TTelThread = nil;
332 begin
333 //Spots.Add('10368961.9 GB3CCX/B 17-Jan-2009 1905Z 51S IO81XW>IO81JM <GW3TKH>')
334 //Spots.Add('DX de GW3TKH 10368961.9 GB3CCX/B 1905Z ');
335 Spots.Add('DX de AK7V-#: 7025.30 AC2K CW 28 dB 27 WPM CQ 0425Z');
336 {
337 if not Running then
338 begin
339 Writeln('aa');
340 if TelThread = nil then
341 begin
342 Writeln('ab');
343 TelThread := TTelThread.Create(True);
344 end;
345 Writeln('bb');
346 TelThread.Start;
347 Writeln('cc');
348 end;
349 }
350 end;
351
352 procedure TfrmDXCluster.btnPreferencesClick(Sender : TObject);
353 var
354 p : TPoint;
355 begin
356 mnuCallalert.Checked := cqrini.ReadBool('DXCluster', 'AlertEnabled', False);
357 mnuSkimAllowFreq.Checked := cqrini.ReadBool('Skimmer', 'AllowFreqEnable', False);
358 mnuSkimQSLCheck.Checked := cqrini.ReadBool('Skimmer', 'QSLEnable', False);
359 ChangeCallAlertCaption;
360 p.x := 10;
361 p.y := 10;
362 p := btnPreferences.ClientToScreen(p);
363 popPreferences.PopUp(p.x, p.y)
364 end;
365
366 procedure TfrmDXCluster.acProgPrefExecute(Sender : TObject);
367 begin
368 cqrini.WriteInteger('Pref', 'ActPageIdx', 10); //set DXCuster tab active. Number may change if preferences page change
369 frmNewQSO.acPreferences.Execute
370 end;
371
372 procedure TfrmDXCluster.acFontExecute(Sender : TObject);
373 begin
374 dlgDXfnt.Font.Name := cqrini.ReadString('DXCluster','Font','DejaVu Sans Mono');
375 dlgDXfnt.Font.Size := cqrini.ReadInteger('DXCluster','FontSize',12);
376 if dlgDXfnt.Execute then
377 begin
378 cqrini.WriteString('DXCluster','Font',dlgDXfnt.Font.Name);
379 cqrini.WriteInteger('DXCluster','FontSize',dlgDXfnt.Font.Size);
380 WebSpots.SetFont(dlgDXfnt.Font);
381 TelSpots.SetFont(dlgDXfnt.Font);
382 ChatSpots.SetFont(dlgDXfnt.Font)
383 end
384 end;
385
386 procedure TfrmDXCluster.acCallAlertExecute(Sender : TObject);
387 begin
388 frmPreferences.btnAlertCallsignsClick(nil)
389 end;
390
391 procedure TfrmDXCluster.acChatSizeExecute(Sender: TObject);
392 begin
393 trChatSize.Max := pnlTelnet.Height -20;
394 trChatSize.Position := pnlChat.Height;
395 trChatSize.Visible :=true;
396 trChatSize.Cursor := crSizeWE;
397 edtCommand.Visible := false;
398 label1.Caption := 'ChatSize';
399 if dmData.DebugLevel >=1 then Writeln('Chat sizing AC');
400 end;
401
402 procedure TfrmDXCluster.FormCreate(Sender: TObject);
403 begin
404 InitCriticalSection(csTelnet);
405 InitCriticalSection(csDXCPref);
406 FirstShow := True;
407 ConOnShow := False;
408 FirstWebGet := True;
409 lTelnet := TLTelnetClientComponent.Create(nil);
410 ReloadDXCPref := True;
411
412 lTelnet.OnConnect := @lConnect;
413 lTelnet.OnDisconnect := @lDisconnect;
414 lTelnet.OnReceive := @lReceive;
415
416 WebSpots := TColorMemo.Create(pnlWeb);
417 WebSpots.parent := pnlWeb;
418 WebSpots.AutoScroll := True;
419 WebSpots.oncDblClick := @WebDbClick;
420 WebSpots.Align := alClient;
421 WebSpots.setLanguage(1);
422
423
424 TelSpots := TColorMemo.Create(pnlTelnet);
425 TelSpots.parent := pnlTelnet;
426 TelSpots.AutoScroll := True;
427 TelSpots.oncDblClick := @TelDbClick;
428 TelSpots.Align := alClient;
429 TelSpots.setLanguage(1);
430
431 ChBckColor := $00D3F3F8;
432 pnlChat.Color := ChBckColor;
433 ChatSpots := TColorMemo.Create(pnlChat);
434 ChatSpots.parent := pnlChat;
435 ChatSpots.autoscroll := True;
436 ChatSpots.Align := alClient;
437 ChatSpots.setLanguage(1);
438
439 Spots := TStringList.Create;
440 Spots.Clear;
441 Chats := TStringList.Create;
442 Chats.Clear;
443
444 Running := False;
445 mindex := 1;
446
447 TelThread := TTelThread.Create(True);
448 TelThread.FreeOnTerminate := True;
449 TelThread.Start;
450 HistPtr:=5; //initialize command history to be clean
451 repeat
452 Begin
453 dec(HistPtr);
454 HistCmd[HistPtr]:=''
455 end;
456 until HistPtr =0;
457 SentStartCmd :=false;
458 end;
459
460 procedure TfrmDXCluster.FormKeyUp(Sender: TObject; var Key: Word;
461 Shift: TShiftState);
462 begin
463 if (key= VK_ESCAPE) then
464 begin
465 frmNewQSO.ReturnToNewQSO;
466 key := 0
467 end
468 end;
469
470 procedure TfrmDXCluster.WebDbClick(where:longint;mb:TmouseButton;ms:TShiftState);
471 var
472 spot : String = '';
473 tmp : Integer = 0;
474 freq : String = '';
475 mode : String = '';
476 call : String = '';
477 etmp : Extended = 0;
478 stmp : String = '';
479 i : Integer = 0;
480 begin
481 WebSpots.ReadLine(spot,tmp,tmp,tmp,where);
482 spot := copy(spot,i+6,Length(spot)-i-5);
483 spot := Trim(spot);
484 freq := GetFreq(spot);
485 call := GetCall(spot,True);
486 {
487 Writeln('WebDbClick*****');
488 Writeln('Spot:',spot);
489 Writeln('Freq:',freq);
490 Writeln('Call:',call);
491 Writeln('***************');
492 }
493 if NOT TryStrToFloat(freq,etmp) then
494 exit;
495 if (not dmData.BandModFromFreq(freq,mode,stmp)) or (mode='') then
496 exit;
497
498 frmNewQSO.NewQSOFromSpot(call,freq,mode)
499 end;
500
501 procedure TfrmDXCluster.TelDbClick(where:longint;mb:TmouseButton;ms:TShiftState);
502 var
503 spot : String = '';
504 tmp : Integer = 0;
505 freq : String = '';
506 mode : String = '';
507 call : String = '';
508 etmp : Extended = 0;
509 stmp : String = '';
510 i : Integer = 0;
511 f : Currency;
512 begin
513 TelSpots.ReadLine(spot,tmp,tmp,tmp,where);
514 if TryStrToCurr(copy(spot,1,Pos(' ',spot)-1),f) then
515 begin
516 freq := copy(spot,1,Pos(' ',spot)-1);
517 call := trim(copy(spot,Pos('.',spot)+2,14))
518 end
519 else begin
520 spot := copy(spot,i+6,Length(spot)-i-5);
521 spot := Trim(spot);
522 freq := GetFreq(Spot);
523 call := GetCall(Spot, ConWeb)
524 end;
525 {
526 Writeln('TelDbClick*****');
527 Writeln('Spot:',spot);
528 Writeln('Freq:',freq);
529 Writeln('Call:',call);
530 Writeln('***************');
531 }
532
533 if NOT TryStrToFloat(freq,etmp) then
534 exit;
535 if (not dmData.BandModFromFreq(freq,mode,stmp)) or (mode='') then
536 exit;
537 frmNewQSO.NewQSOFromSpot(call,freq,mode)
538 end;
539
540
541 procedure TfrmDXCluster.FormShow(Sender: TObject);
542 var
543 f : TFont;
544 begin
545 f := TFont.Create;
546 try
547 f.Name := cqrini.ReadString('DXCluster','Font','DejaVu Sans Mono');
548 f.Size := cqrini.ReadInteger('DXCluster','FontSize',12);
549 WebSpots.SetFont(f);
550 TelSpots.SetFont(f) ;
551 ChatSpots.SetFont(f)
552 finally
553 f.Free
554 end;
555 dmUtils.LoadFontSettings(frmDXCluster);
556 dmUtils.LoadWindowPos(frmDXCluster);
557 ReloadSettings;
558 pgDXCluster.ActivePageIndex := cqrini.ReadInteger('DXCluster','Tab',1);;
559 telDesc := cqrini.ReadString('DXCluster','Desc','');
560 telAddr := cqrini.ReadString('DXCluster','Addr','');
561 telPort := cqrini.ReadString('DXCluster','Port','');
562 telUser := cqrini.ReadString('DXCluster','User','');
563 telPass := cqrini.ReadString('DXCluster','Pass','');
564 edtTelAddress.Text := telDesc;
565
566 mnuCallalert.Checked := cqrini.ReadBool('DXCluster', 'AlertEnabled', False);
567 mnuSkimAllowFreq.Checked := cqrini.ReadBool('Skimmer', 'AllowFreqEnable', False);
568 mnuSkimQSLCheck.Checked := cqrini.ReadBool('Skimmer', 'QSLEnable', False);
569
570 ChangeCallAlertCaption;
571
572 if cqrini.ReadBool('DXCluster', 'ConAfterRun', False) then
573 tmrAutoConnect.Enabled := True;
574 pnlChat.Height := cqrini.ReadInteger('DXCluster','ChatSize',2); //default now 2 = invisible
575 end;
576
577 procedure TfrmDXCluster.btnClearClick(Sender: TObject);
578 begin
579 WebSpots.RemoveAllLines
580 end;
581
582 procedure TfrmDXCluster.btnSelectClick(Sender: TObject);
583 begin
584 frmDXClusterList := TfrmDXClusterList.Create(self);
585 try
586 frmDXClusterList.OldDesc := edtTelAddress.Text;
587 frmDXClusterList.ShowModal;
588 if frmDXClusterList.ModalResult = mrOK then
589 begin
590 telDesc := dmData.qDXClusters.Fields[1].AsString;
591 telAddr := dmData.qDXClusters.Fields[2].AsString;
592 telPort := dmData.qDXClusters.Fields[3].AsString;
593 telUser := dmData.qDXClusters.Fields[4].AsString;
594 telPass := dmData.qDXClusters.Fields[5].AsString;
595 edtTelAddress.Text := telDesc
596 end
597 finally
598 frmDXClusterList.Free
599 end
600 end;
601
602 procedure TfrmDXCluster.btnTelConnectClick(Sender: TObject);
603 begin
604 if ConWeb then
605 begin
606 Application.MessageBox('You are connected to web, you must disconnect it before connect to telnet.',
607 'Info ...',mb_ok + mb_IconInformation);
608 exit
609 end;
610
611 if ConTelnet then
612 begin
613 StopAllConnections;
614 btnTelConnect.Caption := 'Connect';
615 ConWeb := False;
616 end
617 else begin
618 ConnectToTelnet;
619 btnTelConnect.Caption := 'Disconnect';
620 ConTelnet := True;
621 if (Sender <> nil) then
622 edtCommand.SetFocus
623 end
624 end;
625
626 procedure TfrmDXCluster.btnWebConnectClick(Sender: TObject);
627 begin
628 if ConTelnet then
629 begin
630 Application.MessageBox('You are connected with telnet, you must disconnect it before connect to web cluster.',
631 'Info ...',mb_ok + mb_IconInformation);
632 exit
633 end;
634
635 if ConWeb then
636 begin
637 StopAllConnections;
638 btnWebConnect.Caption := 'Connect';
639 ConWeb := False
640 end
641 else begin
642 ConnectToWeb;
643 btnWebConnect.Caption := 'Disconnect';
644 ConWeb := True;
645 end;
646 end;
647
648 procedure TfrmDXCluster.edtCommandKeyPress(Sender: TObject; var Key: char);
649 begin
650 if key=#26 then
651 Begin
652 key := #0;
653 edtCommand.Clear;
654 edtCommand.Text := GetHistCmd;
655 edtCommand.SelStart := Length(edtCommand.Text);
656 end;
657 if key=#19 then
658 Begin
659 key := #0;
660 cqrini.WriteString('DXCluster','StartCmd',edtCommand.Text);
661 if dmData.DebugLevel>=1 then writeln('ClusterStarCommand:_',edtCommand.Text,'_saved');
662 edtCommand.Clear;
663 end;
664 if key=#13 then
665 begin
666 StoreLastCmd(edtCommand.Text);
667 key := #0;
668 SendCommand(edtCommand.Text);
669 edtCommand.Clear
670 end;
671 end;
672
673 procedure TfrmDXCluster.mnuCallalertClick(Sender : TObject);
674 begin
675 mnuCallalert.Checked := not mnuCallalert.Checked;
676 cqrini.WriteBool('DXCluster', 'AlertEnabled', mnuCallalert.Checked);
677 ChangeCallAlertCaption
678 end;
679
680 procedure TfrmDXCluster.mnuSkimAllowFreqClick(Sender: TObject);
681 begin
682 mnuSkimAllowFreq.Checked := not mnuSkimAllowFreq.Checked;
683 cqrini.WriteBool('Skimmer', 'AllowFreqEnable', mnuSkimAllowFreq.Checked);
684 end;
685
686 procedure TfrmDXCluster.mnuSkimQSLCheckClick(Sender: TObject);
687 begin
688 mnuSkimQSLCheck.Checked := not mnuSkimQSLCheck.Checked;
689 cqrini.WriteBool('Skimmer', 'QSLEnable', mnuSkimQSLCheck.Checked);
690 end;
691
692 procedure TfrmDXCluster.tmrAutoConnectTimer(Sender: TObject);
693 begin
694 tmrAutoConnect.Enabled := False;
695 if pgDXCluster.ActivePageIndex = 0 then
696 begin
697 if not ConWeb then
698 btnWebConnectClick(nil)
699 end
700 else begin
701 if not ConTelnet then
702 btnTelConnectClick(nil)
703 end;
704 frmNewQSO.ReturnToNewQSO
705 end;
706
707 procedure TfrmDXCluster.lConnect(aSocket: TLSocket);
708 begin
709 btnTelConnect.Caption := 'Disconnect';
710 ConTelnet := True
711 end;
712
713 procedure TfrmDXCluster.lDisconnect(aSocket: TLSocket);
714 begin
715 btnTelConnect.Caption := 'Connect';
716 ConTelnet := False
717 end;
718
719 procedure TfrmDXCluster.lReceive(aSocket: TLSocket);
720 const
721 CR = #13;
722 LF = #10;
723 var
724 sStart, sStop, SkimCallStartPos, SkimCallStopPos, SkimParserAnchor: Integer;
725 stmp, tmp, Chline, Skimline, SkimCall, SkimFreq, SkimMode, prefix: String;
726 itmp, itmp2, QSLState, SkimCTYid : Integer;
727 buffer : String;
728 f, etmp : Double;
729 cmds :TStringlist;
730 K :integer;
731 begin
732 if lTelnet.GetMessage(buffer) = 0 then
733 exit;
734 sStart := 1;
735 sStop := Pos(CR, Buffer);
736 if sStop = 0 then
737 sStop := Length(Buffer) + 1;
738 while sStart <= Length(Buffer) do
739 begin
740 tmp := Copy(Buffer, sStart, sStop - sStart);
741 tmp := trim(tmp);
742 if dmData.DebugLevel >=1 then Writeln(tmp);
743
744 if Pos(UpperCase(telUser) + ' DE', UpperCase(tmp)) > 0 then
745 Begin
746 ChLine := tmp;
747 if dmData.DebugLevel>=1 then Writeln('pos: ', pos('>',Chline) ,' len:', length(Chline));
748 if pos('>',Chline) < length(Chline) then //if not dxcluster prompt
749 Begin //remove "mycall de" add local timestamp from PC
750 itmp := length(telUser)+4; //4 = ' DE '
751 ChLine := FormatDateTime('hh:nn',Now)+'_'+copy(Chline,itmp+1,length(Chline)-itmp);
752 if dmData.DebugLevel>=1 then Writeln('Chat :',ChLine);
753 EnterCriticalsection(frmDXCluster.csTelnet);
754 if dmData.DebugLevel>=1 then Writeln('Enter critical section On Receive Chat');
755 try
756 Chats.Add(Chline);
757 finally
758 LeaveCriticalsection(csTelnet);
759 if dmData.DebugLevel>=1 then Writeln('Leave critical section On Receive Chat')
760 end
761 end
762 else
763 Begin
764 Chline := '';
765 if dmData.DebugLevel>=1 then Writeln('Chat : line is cluster prompt!');
766 //send start command at first prompt
767 if not SentStartCmd and (cqrini.ReadString('DXCluster','StartCmd','') <> '') then
768 begin
769 cmds := Tstringlist.create;
770 try
771 Assert(Assigned(cmds)) ;
772 cmds.Clear;
773 cmds.StrictDelimiter := true;
774 cmds.Delimiter := ',';
775 cmds.DelimitedText := cqrini.ReadString('DXCluster','StartCmd','') ;
776 for K:=0 to cmds.Count-1 do
777 Begin
778 SendCommand(trim(cmds[K]));
779 if dmData.DebugLevel>=1 then writeln('Sent DXCluster connect start command:',trim(cmds[K]));
780 sleep(100);
781 end;
782 finally
783 FreeAndNil(cmds);
784 end;
785 SentStartCmd := true;
786 end;
787 end;
788 end;
789 if (mnuSkimAllowFreq.Checked) then
790 Begin
791 if Pos('TO ALL DE SKIMMER',UpperCase(tmp)) > 0 then
792 Begin //Handle Double Click in CwSkimmer via Telnet Commands
793 Skimline := tmp;
794 SkimCallStartPos := Pos('"',Skimline) + 1;
795 SkimCallStopPos := Pos('"',copy(Skimline,SkimCallStartPos,Length(Skimline)-SkimCallStartPos));
796 SkimCall := copy(Skimline,SkimCallStartPos,SkimCallStopPos - 1);
797 SkimFreq := copy(Skimline,Pos('at ',Skimline) + 3,Length(Skimline)-Pos('at ',Skimline));
798 if NOT TryStrToFloat(SkimFreq,etmp) then
799 exit;
800 if (not dmData.BandModFromFreq(SkimFreq,SkimMode,stmp)) or (SkimMode='') then
801 exit;
802 if dmData.DebugLevel>=1 then WriteLn('Call: ' + SkimCall + ', Freq: ' + SkimFreq + ', Mode: ' + SkimMode);
803 frmNewQSO.NewQSOFromSpot(SkimCall,SkimFreq,SkimMode);
804 end;
805 end;
806 itmp := Pos('DX DE',UpperCase(tmp));
807 if (itmp > 0) or TryStrToFloat(copy(tmp,1,Pos(' ',tmp)-1),f) then
808 begin
809 EnterCriticalsection(frmDXCluster.csTelnet);
810 if dmData.DebugLevel>=1 then Writeln('Enter critical section On Receive');
811 try
812 Spots.Add(tmp);
813 if Chline <> '' then Chats.Add(Chline);
814 finally
815 LeaveCriticalsection(csTelnet);
816 if dmData.DebugLevel>=1 then Writeln('Leave critical section On Receive')
817 end;
818 if (mnuSkimQSLCheck.Checked) then
819 Begin
820 if (Pos('-#:',UpperCase(tmp)) > 0) then
821 Begin //Handle Spot from Skimmer
822 Skimline := tmp;
823 SkimParserAnchor := Pos('-#:',UpperCase(Skimline));
824 SkimCall := copy(Skimline,SkimParserAnchor + 15 , 16);
825 SkimCall := copy(SkimCall,0, Pos(' ',SkimCall) - 1);
826 SkimFreq := copy(Skimline,SkimParserAnchor + 6, 7);
827 if NOT TryStrToFloat(SkimFreq,etmp) then
828 exit;
829 if (not dmData.BandModFromFreq(SkimFreq,SkimMode,stmp)) or (SkimMode='') then
830 exit;
831 if dmData.DebugLevel>=1 then Writeln('CAll: ' + SkimCall + ' Freq: ' + SkimFreq);
832 SkimCTYid := dmDXCluster.id_country(SkimCall,now,stmp,stmp,stmp,stmp,stmp,stmp,stmp);
833 dmDXCluster.DXCCInfo(SkimCTYid,FloatToStr(etmp/1000),SkimMode,QSLState);
834 if dmData.DebugLevel>=1 then Writeln('QSLState: ' + FloatToStr(QSLState));
835 case QSLState of
836 0:
837 begin
838 lTelnet.SendMessage('SKIMMER/STATUS ' + SkimCall + ' ' + SkimFreq + ' DUPE' + #13 + #10);
839 if dmData.DebugLevel>=1 then Writeln('DUPE');
840 end;
841 1:
842 begin
843 lTelnet.SendMessage('SKIMMER/STATUS ' + SkimCall + ' ' + SkimFreq + ' NEWCTY' + #13 + #10);
844 if dmData.DebugLevel>=1 then Writeln('NEWCTY');
845 end;
846 2:
847 begin
848 lTelnet.SendMessage('SKIMMER/STATUS ' + SkimCall + ' ' + SkimFreq + ' BNDCTY' + #13 + #10);
849 if dmData.DebugLevel>=1 then Writeln('BNDCTY');
850 end;
851 4:
852 begin
853 lTelnet.SendMessage('SKIMMER/STATUS ' + SkimCall + ' ' + SkimFreq + ' NOTCFM' + #13 + #10);
854 if dmData.DebugLevel>=1 then Writeln('NOTCFM');
855 end;
856 else
857 end;
858 end;
859 end;
860 end
861 else begin
862 if (Pos('LOGIN',UpperCase(tmp)) > 0) and (telUser <> '') then
863 lTelnet.SendMessage(telUser+#13+#10);
864 if (Pos('please enter your call',LowerCase(tmp)) > 0) and (telUser <> '') then
865 lTelnet.SendMessage(telUser+#13+#10);
866 if (Pos('PASSWORD',UpperCase(tmp)) > 0) and (telPass <> '') then
867 lTelnet.SendMessage(telPass+#13+#10);
868 TelSpots.AddLine(tmp,clBlack,clWhite,0)
869 end;
870 sStart := sStop + 1;
871 if sStart > Length(Buffer) then
872 Break;
873 if Buffer[sStart] = LF then
874 sStart := sStart + 1;
875 sStop := sStart;
876 while (Buffer[sStop] <> CR) and (sStop <= Length(Buffer)) do
877 sStop := sStop + 1
878 end;
879 lTelnet.CallAction
880 end;
881
882 procedure TfrmDXCluster.SendCommand(cmd : String);
883 begin
884 if lTelnet.Connected then
885 begin
886 lTelnet.SendMessage(cmd + #13#10);
887 TelSpots.AddLine(cmd,clBlack,clWhite,0)
888 end
889 end;
890
891 procedure TfrmDXCluster.tmrSpotsTimer(Sender: TObject);
892 begin
893 if pgDXCluster.ActivePageIndex = 0 then
894 ConnectToWeb;
895 end;
896
897 procedure TfrmDXCluster.trChatSizeChange(Sender: TObject);
898 begin
899 pnlChat.Height := trChatSize.Position;
900 end;
901
902 procedure TfrmDXCluster.trChatSizeClick(Sender: TObject);
903 begin
904 trChatSize.Visible := false;
905 trChatSize.Cursor := crDefault;
906 edtCommand.Visible := true;
907 label1.Caption := 'Command:';
908 cqrini.WriteInteger('DXCluster','ChatSize',trChatSize.Position);
909 pnlChat.Height := trChatSize.Position;
910 if dmData.DebugLevel >=1 then Writeln('Chat sizing Click');
911 end;
912
TfrmDXCluster.GetFreqnull913 function TfrmDXCluster.GetFreq(spot : String) : String;
914 var
915 tmp : String;
916 begin
917 tmp := copy(spot,Pos(' ',spot),Pos('.',spot)+2 - Pos(' ',spot));
918 Result := trim(tmp)
919 end;
920
GetSplitnull921 function TfrmDXCluster.GetSplit(spot : String) : String;
922 var
923 tmp : String;
924 spl : String;
925 spn : String;
926 l : Integer;
927 begin
928 tmp := copy(spot,34,Length(spot)-34);
929 //Writeln('tmp: ',tmp);
930 if Pos('UP',tmp)>0 then begin
931 spl:= copy(tmp,Pos('UP',tmp),13);
932 spn:='UP';
933 for l:=3 to Length(spl) do
934 if Pos(spl[l],' 0123456789.,-+')>0 then
935 spn:=spn+spl[l]
936 else break;
937 end;
938 if Pos('DOWN',tmp)>0 then begin
939 spl:= copy(tmp,Pos('DOWN',tmp),13);
940 spn:='DOWN';
941 for l:=5 to Length(spl) do
942 if Pos(spl[l],' 0123456789.,-+')>0 then
943 spn:=spn+spl[l]
944 else break;
945 end;
946 if Pos('QSX',tmp)>0 then begin
947 spl:= copy(tmp,Pos('QSX',tmp),13);
948 spn:='QSX';
949 for l:=4 to Length(spl) do
950 if Pos(spl[l],' 0123456789.,-+')>0 then
951 spn:=spn+spl[l]
952 else break;
953 end;
954 Result := trim(spn)
955 end;
956
GetCallnull957 function TfrmDXCluster.GetCall(spot : String; web : Boolean = False) : String;
958 var
959 tmp : String='';
960 begin
961 if web then
962 begin
963 //Writeln('spot:',spot);
964 tmp := trim(copy(spot,Pos(' ',spot)+1, Length(spot) -(Pos(' ',spot))));
965 //Writeln('tmp: ',tmp);
966 tmp := copy(tmp,Pos(' ',tmp)+1, Length(tmp) -(Pos(' ',tmp)));
967 //Writeln('tmp: ',tmp);
968 if Pos(' ',tmp) > 0 then
969 tmp := trim(copy(tmp,1,Pos(' ',tmp)));
970 //Writeln('tmp: ',tmp);
971 end
972 else begin
973 tmp := copy(spot,Pos('.',spot)+3,Length(spot)-Pos('.',spot)-1);
974 tmp := trim(tmp);
975 tmp := trim(copy(tmp,1,Pos(' ',tmp)))
976 end;
977 Result := tmp
978 end;
979
980 procedure TfrmDXCluster.StopAllConnections;
981 begin
982 if ConWeb then
983 tmrSpots.Enabled := False;
984 if ConTelnet then
985 begin
986 if lTelnet.Connected then
987 lTelnet.Disconnect;
988 ConTelnet := False;
989 SentStartCmd := False;
990 end;
991 end;
992
ShowSpotnull993 function TfrmDXCluster.ShowSpot(spot : String; var sColor : Integer; var Country : String; FromTelnet : Boolean = True) : Boolean;
994 var
995 kmitocet : Extended = 0.0;
996 call : String = '';
997 freq : String = '';
998 tmp : Integer = 0;
999 band : String = '';
1000 mode : String = '';
1001 freeText : String = '';
1002 seznam : TStringList;
1003 i : Integer = 0;
1004 prefix : String = '';
1005 index : Integer = 0;
1006 stmp : String = '';
1007 waz : String = '';
1008 itu : String = '';
1009 cont : String = '';
1010 ToBandMap : Boolean = False;
1011 wDXCC : String = '';
1012 wWAZ : String = '';
1013 wITU : String = '';
1014 iDXCC : String = '';
1015 iWAZ : String = '';
1016 iITU : String = '';
1017 lat : String = '';
1018 long : String = '';
1019 adif : Word = 0;
1020 f : Currency;
1021 kHz : String;
1022 splitstr : String;
1023 cLat, cLng : Currency;
1024 isLoTW : Boolean;
1025 isEQSL : Boolean;
1026
1027 cfgUseBackColor : Boolean = True;
1028 cfgBckColor : TColor;
1029 cfgeUseBackColor : Boolean = True;
1030 cfgeBckColor : TColor;
1031 cfgiDXCC : String;
1032 cfgwIOTA : Boolean;
1033 cfgNewCountryColor : TColor;
1034 cfgNewBandColor : TColor;
1035 cfgNewModeColor : TColor;
1036 cfgNeedQSLColor : TColor;
1037 cfgShowFrom : Integer;
1038 cfgLastSpots : String;
1039 cfgIgnoreBandFreq : Boolean;
1040 cfgUseDXCColors : Boolean;
1041 cfgClusterColor : TColor;
1042 cfgNotShow : String;
1043
1044 cfgCW : Boolean;
1045 cfgSSB : Boolean;
1046 cfgEU : Boolean;
1047 cfgAS : Boolean;
1048 cfgAF : Boolean;
1049 cfgNA : Boolean;
1050 cfgSA : Boolean;
1051 cfgAN : Boolean;
1052 cfgOC : Boolean;
1053 begin
1054 sColor := 0; //cerna
1055
1056 EnterCriticalSection(csDXCPref);
1057 try
1058 cfgUseBackColor := gcfgUseBackColor;
1059 cfgBckColor := gcfgBckColor;
1060 cfgeUseBackColor := gcfgeUseBackColor;
1061 cfgeBckColor := gcfgeBckColor;
1062 wDXCC := gwDXCC;
1063 iDXCC := giDXCC;
1064 wWAZ := gwWAZ;
1065 iWAZ := giWAZ;
1066 wITU := gwITU;
1067 iITU := giITU;
1068 cfgCW := gcfgCW;
1069 cfgSSB := gcfgSSB;
1070 cfgEU := gcfgEU;
1071 cfgAS := gcfgAS;
1072 cfgNA := gcfgNA;
1073 cfgSA := gcfgSA;
1074 cfgAF := gcfgAF;
1075 cfgAN := gcfgAN;
1076 cfgOC := gcfgOC;
1077 cfgiDXCC := gcfgiDXCC;
1078 cfgwIOTA := gcfgwIOTA;
1079 cfgNewCountryColor := gcfgNewCountryColor;
1080 cfgNewBandColor := gcfgNewBandColor;
1081 cfgNewModeColor := gcfgNewModeColor;
1082 cfgNeedQSLColor := gcfgNeedQSLColor;
1083 cfgShowFrom := gcfgShowFrom;
1084 cfgLastSpots := gcfgLastSpots;
1085 cfgIgnoreBandFreq := gcfgIgnoreBandFreq;
1086 cfgUseDXCColors := gcfgUseDXCColors;
1087 cfgClusterColor := gcfgClusterColor;
1088 cfgNotShow := gcfgNotShow
1089 finally
1090 LeaveCriticalSection(csDXCPref)
1091 end;
1092
1093 spot := UpperCase(spot);
1094 i := Pos('DX DE ',spot);
1095 if i > 0 then
1096 spot := copy(spot,i+6,Length(spot)-i-5);
1097
1098 if TryStrToCurr(copy(spot,1,Pos(' ',spot)-1),f) then
1099 begin
1100 freq := copy(spot,1,Pos(' ',spot)-1);
1101 call := trim(copy(spot,Pos('.',spot)+2,14))
1102 end
1103 else begin
1104 freq := GetFreq(Spot);
1105 call := GetCall(Spot, ConWeb)
1106 end;
1107
1108 splitstr := GetSplit(Spot);
1109
1110 kHz := Freq;
1111
1112 tmp := Pos('.',freq);
1113 if tmp > 0 then
1114 freq[tmp] := FormatSettings.DecimalSeparator;
1115 tmp := Pos(',',freq);
1116 if tmp > 0 then
1117 freq[tmp] := FormatSettings.DecimalSeparator;
1118
1119 isLoTW := dmData.UsesLotw(call);
1120 isEQSL := dmDXCluster.UseseQSL(call);
1121
1122 //DXCluster - default Backgroundcolor white
1123 //case lotw and eqsl is given, lotw will win
1124 ThBckColor := clWhite;
1125 if cfgeUseBackColor and isEQSL then
1126 ThBckColor := cfgeBckColor;
1127 if cfgUseBackColor and isLoTW then
1128 ThBckColor := cfgBckColor;
1129
1130 if not TryStrToFloat(freq,kmitocet) then
1131 begin
1132 Result := False;
1133 exit
1134 end;
1135 if (not dmDXCluster.BandModFromFreq(freq,mode,band)) or (mode='') then
1136 begin
1137 Result := False;
1138 if dmData.DebugLevel >=1 then
1139 Writeln('Cannot find out mode from frequency, exiting ...');
1140 exit
1141 end;
1142 if band = '' then
1143 begin
1144 Result := False;
1145 if dmData.DebugLevel >=1 then
1146 Writeln('Wrong band, exiting ...');
1147 exit
1148 end;
1149 freq := FloatToStr(kmitocet/1000);
1150 adif := dmDXCluster.id_country(call,now,prefix,stmp,waz,itu,cont,lat,long);
1151 prefix := dmDXCluster.PfxFromADIF(adif);
1152 Country := dmDXCluster.CountryFromADIF(adif);
1153 dmDXCluster.DXCCInfo(adif,freq,mode,index);
1154 if dmData.DebugLevel>=1 then
1155 begin
1156 Writeln('dx_prefix:',prefix);
1157 Writeln('dx_cont: ',cont);
1158 Writeln('Freq: ',freq);
1159 Writeln('Call: ',call)
1160 end;
1161 if dmData.DebugLevel >=2 then
1162 begin
1163 Writeln('Prefix: ',prefix);
1164 WriteLn('index_: ',index)
1165 end;
1166 if dmData.DebugLevel >=1 then
1167 begin
1168 Writeln('Color: ',ColorToString(sColor));
1169 Writeln('Index_: ',index)
1170 end;
1171
1172 cont := UpperCase(cont);
1173 Result := True;
1174
1175 if Pos('.',band) > 0 then
1176 stmp := StringReplace(band,'.','',[rfReplaceAll, rfIgnoreCase])
1177 else
1178 stmp := band;
1179 if not cqrini.ReadBool('DXCluster','Show'+stmp,True) then
1180 begin
1181 Result := false;
1182 if dmData.DebugLevel >=1 then
1183 Writeln('Cannot show this sport because of settings ...');
1184 exit
1185 end;
1186
1187 if not cfgCW then
1188 begin
1189 if (mode='CW') then
1190 Result := False
1191 end;
1192
1193 if not cfgSSB then
1194 begin
1195 if (mode='SSB') then
1196 Result := false
1197 end;
1198
1199 if (result = False) then
1200 exit;
1201
1202 if wDXCC = '*' then
1203 begin
1204 if Pos(prefix+';',iDXCC) = 0 then
1205 ToBandMap := True
1206 else
1207 ToBandMap := False
1208 end;
1209 if iDXCC = '*' then
1210 begin
1211 if Pos(prefix+';',wDXCC) > 0 then
1212 ToBandMap := True
1213 else
1214 ToBandMap := False
1215 end;
1216 if wWAZ = '*' then
1217 begin
1218 if Pos(waz+';',iWAZ) = 0 then
1219 ToBandMap := True
1220 else
1221 ToBandMap := False
1222 end;
1223 if iWAZ = '*' then
1224 begin
1225 if Pos(waz+';',wWAZ) > 0 then
1226 ToBandMap := True
1227 else
1228 ToBandMap := False
1229 end;
1230 if wITU = '*' then
1231 begin
1232 if Pos(itu+';',iITU) = 0 then
1233 ToBandMap := True
1234 else
1235 ToBandMap := False
1236 end;
1237 if iITU = '*' then
1238 begin
1239 if Pos(itu+';',wITU) > 0 then
1240 ToBandMap := True
1241 else
1242 ToBandMap := False
1243 end;
1244 if (cont='EU') and cfgEU then
1245 ToBandMap := True
1246 else begin
1247 if (cont='AS') and cfgAS then
1248 ToBandMap := True
1249 else begin
1250 if (cont='NA') and cfgNA then
1251 ToBandMap := True
1252 else begin
1253 if (cont='SA') and cfgSA then
1254 ToBandMap := True
1255 else begin
1256 if (cont='AF') and cfgAF then
1257 ToBandMap := True
1258 else begin
1259 if (cont='OC') and cfgOC then
1260 ToBandMap := True
1261 else begin
1262 if (cont='AN') and cfgAN then
1263 ToBandMap := True
1264 else
1265 ToBandMap := False
1266 end
1267 end
1268 end
1269 end
1270 end
1271 end;
1272
1273 if Pos(prefix+';',cfgiDXCC+';') > 0 then
1274 ToBandMap := False;
1275 if not ToBandMap then
1276 begin
1277 if cfgwIOTA then
1278 begin
1279 if dmUtils.IsItIOTA(spot) then
1280 ToBandMap := True
1281 end
1282 end;
1283 if index = 0 then
1284 sColor := 0;
1285 if index = 1 then
1286 sColor := cfgNewCountryColor;
1287 if index = 2 then
1288 sColor := cfgNewBandColor;
1289 if index = 3 then
1290 sColor := cfgNewModeColor;
1291 if index = 4 then
1292 sColor := cfgNeedQSLColor;
1293
1294 if (cont='') or (prefix='') then
1295 ToBandMap := True; //for MM stations etc.
1296
1297 if cfgShowFrom = 0 then
1298 begin
1299 dmDXCluster.AddToMarkFile(prefix,call,sColor,cfgLastSpots,lat,long)
1300 end;
1301
1302 if dmUtils.IgnoreFreq(kHz) and cfgIgnoreBandFreq then
1303 begin
1304 if dmData.DebugLevel >=1 then Writeln('This freq: ',freq,' is ignored');
1305 ToBandMap := False
1306 end;
1307
1308 if index > 0 then
1309 begin
1310 seznam := TStringList.Create;
1311 try
1312 seznam.Clear;
1313 seznam.Delimiter := ';';
1314 seznam.DelimitedText := cfgNotShow;
1315 for i:=0 to seznam.Count-1 do
1316 begin
1317 if (prefix=seznam.Strings[i]) then
1318 begin
1319 Result:= False;
1320 if dmData.DebugLevel >=1 then
1321 Writeln('Cannot show this sport because of prefix ...');
1322 Break
1323 end
1324 end
1325 finally
1326 seznam.Free
1327 end
1328 end;
1329
1330 if Result then
1331 begin
1332 if ToBandMap and frmBandMap.Showing then
1333 begin
1334 dmDXCluster.GetRealCoordinate(lat,long,cLat,cLng);
1335
1336 if cfgUseDXCColors then
1337 frmBandMap.AddToBandMap(kmitocet,call,mode,band,splitstr,cLat,cLng,sColor,ThBckColor, False, isLoTW, isEQSL)
1338 else
1339 frmBandMap.AddToBandMap(kmitocet,call,mode,band,splitstr,cLat,cLng,
1340 cfgClusterColor,ThBckColor, False, isLoTW, isEQSL)
1341 end
1342 end;
1343
1344 if ( mnuCallalert.Checked and ConTelnet ) then // do not run IsAlertCall unless alert is selected
1345 // and connected to telnet cluster
1346 if (dmDXCluster.IsAlertCall(call,band,mode,cqrini.ReadBool('DxCluster', 'AlertRegExp', False))) then
1347 Begin
1348 freeText:= dmDXCluster.GetfreeTextFromSpot('DX de '+spot);
1349 if dmData.DebugLevel >=1 then
1350 Writeln('Spot is:',spot,#$0A,'----Call alerting is: ',call,',',band,',',mode,',',freq,',',freeText,'-----------');
1351 dmDXCluster.RunCallAlertCmd(call,band,mode,freq,freeText);
1352 call :='';
1353 end;
1354 if dmData.DebugLevel >=1 then
1355 begin
1356 Writeln('Color: ',ColorToString(sColor));
1357 Writeln('Index_: ',index)
1358 end
1359 end;
1360
1361 procedure TTelThread.Execute;
1362 var
1363 dx : String;
1364 sColor : TColor;
1365 Country : String;
1366 begin
1367 while true do
1368 begin
1369 while Spots.Count > 0 do
1370 begin
1371 if dmData.DebugLevel>=2 then Writeln('TelThread.Execute - enter critical section ');
1372 EnterCriticalsection(frmDXCluster.csTelnet);
1373 try
1374 dx := dmUtils.MyTrim(spots.Strings[0]);
1375 spots.Delete(0)
1376 finally
1377 LeaveCriticalsection(frmDXCluster.csTelnet);
1378 if dmData.DebugLevel>=2 then Writeln('TelThread.Execute - leave critical section ');
1379 end;
1380 if dmData.DebugLevel >= 2 then Writeln('Spot: ',dx);
1381 if frmDXCluster.ShowSpot(dx,sColor, Country) then
1382 begin
1383 if cqrini.ReadBool('DXCluster','ShowDxcCountry',False) then
1384 ThSpot := dx + ' ' + Country
1385 else
1386 ThSpot := dx;
1387 ThColor := sColor;
1388 ThInfo := '';
1389 if dmData.DebugLevel>=2 then
1390 begin
1391 Writeln('Spot nr. ',mindex);
1392 WriteLn('ThSpot: ',ThSpot);
1393 Writeln('ThColor: ',ThColor)
1394 end;
1395 if dmData.DebugLevel>=1 then Writeln('TelThread.Execute - before Synchronize(@frmDXCluster.SynTelnet)');
1396 Synchronize(@frmDXCluster.SynTelnet);
1397 if dmData.DebugLevel>=1 then Writeln('TelThread.Execute - after Synchronize(@frmDXCluster.SynTelnet)')
1398 end
1399 end;
1400
1401 while Chats.Count > 0 do
1402 begin
1403 if dmData.DebugLevel>=2 then Writeln('TelThread.Execute - enter critical section Chat ');
1404 EnterCriticalsection(frmDXCluster.csTelnet);
1405 try
1406 ThChat := Trim(Chats.Strings[0]);
1407 Chats.Delete(0)
1408 finally
1409 LeaveCriticalsection(frmDXCluster.csTelnet);
1410 if dmData.DebugLevel>=2 then Writeln('TelThread.Execute - leave critical section Chat ');
1411 end;
1412 if dmData.DebugLevel >= 2 then Writeln('Chat: ',ThChat);
1413 if dmData.DebugLevel>=1 then Writeln('TelThread.Execute - before Synchronize(@frmDXCluster.SynChat)');
1414 Synchronize(@frmDXCluster.SynChat);
1415 if dmData.DebugLevel>=1 then Writeln('TelThread.Execute - after Synchronize(@frmDXCluster.SynChat)')
1416 end;
1417
1418 sleep(500)
1419 end
1420 end;
1421
1422 procedure TWebThread.Execute;
1423
SpacesFromLeftnull1424 function SpacesFromLeft(What : String; TargetLen : Integer) : String;
1425 var
1426 n : Integer;
1427 i : Integer;
1428 begin
1429 Result := What;
1430 n := TargetLen - Length(what);
1431 if n < 0 then
1432 Result := copy(What,1,abs(n))
1433 else begin
1434 for i:=Length(What) to TargetLen do
1435 begin
1436 Result := ' '+Result;
1437 //Writeln(Result)
1438 end
1439 end
1440 end;
1441
SpacesFromRightnull1442 function SpacesFromRight(What : String; TargetLen : Integer) : String;
1443 var
1444 n : Integer;
1445 i : Integer;
1446 begin
1447 Result := What;
1448 n := TargetLen - Length(what);
1449 if n < 0 then
1450 Result := copy(What,1,abs(n))
1451 else begin
1452 for i:=Length(What) to TargetLen do
1453 begin
1454 Result := Result+' ';
1455 //Writeln(Result+'*')
1456 end
1457 end
1458 end;
1459
Explodenull1460 function Explode(const cSeparator, vString: String): TExplodeArray;
1461 var
1462 i: integer;
1463 S: string;
1464 begin
1465 S := vString;
1466 SetLength(Result, 0);
1467 i := 0;
1468 while Pos(cSeparator, S) > 0 do
1469 begin
1470 SetLength(Result, Length(Result) + 1);
1471 Result[i] := Copy(S, 1, Pos(cSeparator, S) - 1);
1472 Inc(i);
1473 S := Copy(S, Pos(cSeparator, S) + Length(cSeparator), Length(S))
1474 end;
1475 SetLength(Result, Length(Result) + 1);
1476 Result[i] := Copy(S, 1, Length(S))
1477 end;
1478
1479 var
1480 i,tmp : Integer;
1481 HTTP : THTTPSend;
1482 sp : TStringList;
1483 spot : String;
1484 a : TExplodeArray;
1485 sColor : TColor;
1486 Country : String;
1487 x : String;
1488 limit : String;
1489 begin
1490 if dmData.DebugLevel>=1 then
1491 Writeln('In TWebThread.Execute');
1492 FreeOnTerminate := True;
1493 frmDXCluster.Running := True;
1494 HTTP := THTTPSend.Create;
1495 sp := TStringList.Create;
1496 try
1497 if BiggerFetch then
1498 limit := '60'
1499 else
1500 limit := '20';
1501 sp.Clear;
1502 ThInfo := 'Connecting ...';
1503 Synchronize(@frmDXCluster.SynWeb);
1504 HTTP.ProxyHost := cqrini.ReadString('Program','Proxy','');
1505 HTTP.ProxyPort := cqrini.ReadString('Program','Port','');
1506 HTTP.UserName := cqrini.ReadString('Program','User','');
1507 HTTP.Password := cqrini.ReadString('Program','Passwd','');
1508 if not HTTP.HTTPMethod('GET','http://www.hamqth.com/dxc_csv.php?limit='+limit) then
1509 begin
1510 frmDXCluster.StopAllConnections;
1511 frmDXCluster.btnWebConnect.Click;
1512 exit
1513 end;
1514 ThInfo := 'Downloading spots ...';
1515 Synchronize(@frmDXCluster.SynWeb);
1516 sp.LoadFromStream(HTTP.Document);
1517 for i:=0 to sp.Count-1 do
1518 begin
1519 EnterCriticalsection(frmDXCluster.csTelnet);
1520 if dmData.DebugLevel>=1 then Writeln('Enter critical section TWebThread.Execute');
1521 try
1522 a := Explode('^',sp.Strings[i]);
1523 if Length(a) < 3 then
1524 Continue;
1525 spot := SpacesFromRight('DX de '+a[0]+':',13)+ //spotter
1526 SpacesFromLeft(a[1],8)+ ' '+ //freq
1527 SpacesFromRight(a[2],12)+ ' ' + //dxcall
1528 SpacesFromRight(a[3],28)+ ' ' + //comment
1529 copy(a[4],1,4)+'Z';
1530 {
1531 Writeln(SpacesFromRight('DX de '+a[0]+':',14),'|',Length(SpacesFromRight('DX de '+a[0]+':',14)));
1532 Writeln(SpacesFromLeft(a[1],9),'|',Length(SpacesFromLeft(a[1],9)));
1533 Writeln(SpacesFromRight(a[2],13),'|',Length(SpacesFromRight(a[2],13)));
1534 Writeln(SpacesFromRight(a[3],29),'|',Length(SpacesFromRight(a[3],29)));
1535 Writeln(copy(a[4],1,4)+'Z','|',Length(copy(a[4],1,4)+'Z'));
1536 }
1537 if dmData.DebugLevel>=1 then Writeln('Adding from web:',spot);
1538 if frmDXCluster.ShowSpot(spot,sColor, Country) then
1539 begin
1540 if cqrini.ReadBool('DXCluster','ShowDxcCountry',False) then
1541 ThSpot := spot + ' ' + Country
1542 else
1543 ThSpot := spot;
1544 ThColor := sColor;
1545 ThInfo := '';
1546 Synchronize(@frmDXCluster.SynWeb)
1547 end
1548 finally
1549 LeaveCriticalsection(frmDXCluster.csTelnet);
1550 if dmData.DebugLevel>=1 then Writeln('Leave critical section TWebThread.Execute')
1551 end
1552 end
1553 finally
1554 ThInfo := '';
1555 HTTP.Free;
1556 sp.Free;
1557 frmDXCluster.Running := False
1558 end
1559 end;
1560
1561 procedure TfrmDXCluster.SynWeb;
1562 begin
1563 lblInfo.Caption := ThInfo;
1564 if WebSpots.Search(ThSpot,0,True,True) = -1 then
1565 begin
1566 WebSpots.DisableAutoRepaint(true);
1567 WebSpots.AddLine(ThSpot,ThColor,ThBckColor,0);
1568 WebSpots.DisableAutoRepaint(false)
1569 end
1570 {
1571 if ThSpot = '' then
1572 exit;
1573 Writeln('******************* Hledam:',ThSpot,'********');
1574 if WebSpots.Search(ThSpot,1,True,True) = -1 then
1575 begin
1576 Writeln('*****************Nenasel:',ThSpot,'********');
1577 WebSpots.DisableAutoRepaint(true);
1578 WebSpots.vloz_vetu(ThSpot,ThColor,clWhite,0,0);
1579 WebSpots.DisableAutoRepaint(false);
1580 Sleep(200)
1581 end
1582 else
1583 Writeln('*****************Nenasel:',ThSpot,'********');
1584 }
1585 end;
1586
1587 procedure TfrmDXCluster.SynTelnet;
1588 begin
1589 //if dmData.DebugLevel>=1 then Writeln('TfrmDXCluster.SynTelnet - begin ');
1590 if ThSpot = '' then
1591 exit;
1592 //if dmData.DebugLevel>=1 then Writeln('TfrmDXCluster.SynTelnet - before MapToScreen');
1593 //frmBandMap.MapToScreen;
1594 //if dmData.DebugLevel>=1 then Writeln('TfrmDXCluster.SynTelnet - Before ]'yu
1595 if ConTelnet then
1596 begin
1597 TelSpots.DisableAutoRepaint(true);
1598 TelSpots.AddLine(ThSpot,ThColor,ThBckColor,0);
1599 TelSpots.DisableAutoRepaint(false)
1600 end
1601 else begin
1602 {
1603 if WebSpots.Search(ThSpot,0,True,True) = -1 then
1604 begin
1605 WebSpots.DisableAutoRepaint(true);
1606 WebSpots.vloz_vetu(ThSpot,ThColor,ThBckColor,0,0);
1607 WebSpots.DisableAutoRepaint(false);
1608 end
1609 }
1610 end;
1611 //if dmData.DebugLevel>=1 then Writeln('TfrmDXCluster.SynTelnet - before PridejVetu ');
1612 //if dmData.DebugLevel>=1 then Writeln('TfrmDXCluster.SynTelnet - after zakaz_kresleni');
1613 //Sleep(200)
1614 end;
1615 procedure TfrmDXCluster.SynChat;
1616 begin
1617
1618 if ThChat = '' then
1619 exit;
1620
1621 if ConTelnet then
1622 begin
1623 ChatSpots.DisableAutoRepaint(true);
1624 ChatSpots.AddLine(ThChat,clBlack,ChBckColor,0);
1625 ChatSpots.DisableAutoRepaint(false)
1626 end;
1627 end;
1628
1629 procedure TfrmDXCluster.ReloadSettings;
1630 begin
1631 EnterCriticalSection(csDXCPref);
1632 try
1633 gcfgUseBackColor := cqrini.ReadBool('LoTW','UseBackColor',True);
1634 gcfgBckColor := cqrini.ReadInteger('LoTW','BckColor',clMoneyGreen);
1635 gcfgeUseBackColor := cqrini.ReadBool('LoTW','eUseBackColor',True);
1636 gcfgeBckColor := cqrini.ReadInteger('LoTW','eBckColor',clSkyBlue);
1637 gwDXCC := cqrini.ReadString('BandMap','wDXCC','*');
1638 giDXCC := cqrini.ReadString('BandMap','iDXCC','');
1639 gwWAZ := cqrini.ReadString('BandMap','wWAZ','*');
1640 giWAZ := cqrini.ReadString('BandMap','iWAZ','');
1641 gwITU := cqrini.ReadString('BandMap','wITU','*');
1642 giITU := cqrini.ReadString('BandMap','iITU','');
1643 gcfgCW := cqrini.ReadBool('DXCluster','CW',true);
1644 gcfgSSB := cqrini.ReadBool('DXCluster','SSB',True);
1645 gcfgEU := cqrini.ReadBool('BandMap','wEU',True);
1646 gcfgAS := cqrini.ReadBool('BandMap','wAS',True);
1647 gcfgNA := cqrini.ReadBool('BandMap','wNA',True);
1648 gcfgSA := cqrini.ReadBool('BandMap','wSA',True);
1649 gcfgAF := cqrini.ReadBool('BandMap','wAF',True);
1650 gcfgAN := cqrini.ReadBool('BandMap','wAN',True);
1651 gcfgOC := cqrini.ReadBool('BandMap','wOC',True);
1652 gcfgiDXCC := cqrini.ReadString('BandMap','iDXCC','');
1653 gcfgwIOTA := cqrini.ReadBool('BandMap','wIOTA', True);
1654 gcfgNewCountryColor := cqrini.ReadInteger('DXCluster','NewCountry',0);
1655 gcfgNewBandColor := cqrini.ReadInteger('DXCluster','NewBand',0);
1656 gcfgNewModeColor := cqrini.ReadInteger('DXCluster','NewMode',0);
1657 gcfgNeedQSLColor := cqrini.ReadInteger('DXCluster','NeedQSL',0);
1658 gcfgShowFrom := cqrini.ReadInteger('xplanet','ShowFrom',0);
1659 gcfgLastSpots := cqrini.ReadString('xplanet','LastSpots','20');
1660 gcfgIgnoreBandFreq := cqrini.ReadBool('BandMap','IgnoreBandFreq',True);
1661 gcfgUseDXCColors := cqrini.ReadBool('BandMap','UseDXCColors',False);
1662 gcfgClusterColor := cqrini.ReadInteger('BandMap','ClusterColor',clBlack);
1663 gcfgNotShow := cqrini.ReadString('DXCluster','NotShow','')
1664 finally
1665 LeaveCriticalSection(csDXCPref)
1666 end
1667 end;
1668
1669 procedure TfrmDXCluster.ChangeCallAlertCaption;
1670 begin
1671 if mnuCallalert.Checked then
1672 mnuCallalert.Caption := 'Callsign alert enabled'
1673 else
1674 mnuCallalert.Caption := 'Enable callsign alert'
1675 end;
1676
1677 end.
1678
1679
1680