forked from rickparrish/RMDoor
-
Notifications
You must be signed in to change notification settings - Fork 0
/
door.pas
1233 lines (1114 loc) · 33.4 KB
/
door.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
unit Door;
{$mode objfpc}{$h+}
interface
uses
Ansi, Comm, DropFiles, StringUtils, VideoUtils,
Classes, Crt, DateUtils, StrUtils, SysUtils;
const
DOOR_INPUT_CHARS_ALL = '`1234567890-=\qwertyuiop[]asdfghjkl;''zxcvbnm,./~!@#$%^&*()_+|QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>? ';
DOOR_INPUT_CHARS_ALPHA = 'qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM';
DOOR_INPUT_CHARS_NUMERIC = '1234567890';
DOOR_INPUT_CHARS_FILENAME = '1234567890-=\qwertyuiop[]asdfghjkl;''zxcvbnm,.~!@#$%^&()_+QWERTYUIOP{}ASDFGHJKL:ZXCVBNM ';
type
TDoorEmulationType = (etANSI, etASCII);
{
When a dropfile is read there is some useless information so it is not
necessary to store the whole thing in memory. Instead only certain
parts are saved to this record
Supported Dropfiles
A = Found In DOOR32.SYS
B = Found In DORINFO*.DEF
C = Found In DOOR.SYS
D = Found In INFO.*
E = Supported By WINServer
}
TDoorDropInfo = Record
Access : LongInt; {ABC--} {User's Access Level}
Alias : String; {ABCDE} {User's Alias/Handle}
Baud : LongInt; {ABCDE} {Connection Baud Rate}
Clean : Boolean; {---D-} {Is LORD In Clean Mode?}
ComNum : LongInt; {ABCD-} {Comm/Socket Number}
ComType : Byte; {A----} {Comm Type (0=Local, 1=Serial, 2=Socket, 3=WC5}
Emulation : TDoorEmulationType; {ABCDE} {User's Emulation (etANSI or etASCII)}
Fairy : Boolean; {---D-} {Does LORD User Have Fairy?}
MaxSeconds: LongInt; {ABCDE} {User's Time Left At Start (In Seconds)}
Node : LongInt; {A-C-E} {Node Number}
RealName : String; {ABCDE} {User's Real Name}
RecPos : LongInt; {A-CD-} {User's Userfile Record Position (Always 0 Based)}
Registered: Boolean; {---D-} {Is LORD Registered?}
end;
TDoorLastKeyType = (lkNone, lkLocal, lkRemote);
{
Information about the last key pressed is stored in this record.
This should be considered read-only.
}
TDoorLastKey = Record
Ch: Char; { Character of last key }
Extended: Boolean; { Was character preceded by #0 }
Location: TDoorLastKeyType; { Location of last key }
Time: TDateTime; { SecToday of last key }
end;
{
MORE prompts will use these two lines based on whether use has ANSI or ASCII
}
TDoorMOREPrompts = Record
ASCII: String; { Used by people with ASCII }
ANSI: String; { Used by people with ANSI }
ANSITextLength: Integer; { ANSI may have non-displaying characters, we need to know the length of just the text }
end;
{
Information about the current session is stored in this record.
}
TDoorSession = Record
DoIdleCheck: Boolean; { Check for idle timeout? }
Events: Boolean; { Run Events in mKeyPressed function }
EventsTime: TDateTime; { MSecToday of last Events run }
LocalRead: Boolean; { Whether to read from the local console or not }
LocalWrite: Boolean; { Whether to write to local console or not }
MaxIdle: LongInt; { Max idle before kick (in seconds) }
SethWrite: Boolean; { Whether to interpret ` codes }
TimeOn: TDateTime; { SecToday program was started }
end;
var
DoorDropInfo: TDoorDropInfo;
DoorLastKey: TDoorLastKey;
DoorLiteBarIndex: Integer;
DoorLiteBarOptions: TStringList;
DoorMOREPrompts: TDoorMOREPrompts;
DoorProgramNameAndVersion: String;
DoorSession: TDoorSession;
{
Event variables that may be called at various times throughout
the programs execution. Assign them to your own procedures to
give your program a more unique look
}
DoorOnCLP: Procedure(AKey: Char; AValue: String);
DoorOnHangup: Procedure;
DoorOnLocalLogin: Procedure;
DoorOnStatusBar: Procedure;
DoorOnSysopKey: Function(AKey: Char): Boolean;
DoorOnTimeOut: Procedure;
DoorOnTimeOutWarning: Procedure(AMinutes: Byte);
DoorOnTimeUp: Procedure;
DoorOnTimeUpWarning: Procedure(AMinutes: Byte);
DoorOnUsage: Procedure;
function DoorCarrier: Boolean;
procedure DoorClose(ADisconnect: Boolean);
procedure DoorClrScr;
procedure DoorCursorDown(ACount: Byte);
procedure DoorCursorLeft(ACount: Byte);
procedure DoorCursorRestore;
procedure DoorCursorRight(ACount: Byte);
procedure DoorCursorSave;
procedure DoorCursorUp(ACount: Byte);
procedure DoorDisplayFile(AFilename: String);
procedure DoorDisplaySixel(AFilename: String);
procedure DoorGotoX(AX: Byte);
procedure DoorGotoXY(AX, AY: Byte);
procedure DoorGotoY(AY: Byte);
function DoorInput(ADefaultText, AAllowedCharacters: String; APasswordCharacter: Char; AVisibleLength, AMaxLength, AAttr: Byte): String;
function DoorKeyPressed: Boolean;
function DoorLiteBar(APageSize: Integer): Boolean;
function DoorLocal: Boolean;
function DoorOpenComm: Boolean;
function DoorReadKey: Char;
function DoorSecondsIdle: LongInt;
function DoorSecondsLeft: LongInt;
procedure DoorShutDown;
procedure DoorStartUp;
function DoorSTDIO: Boolean;
procedure DoorTextAttr(AAttr: Byte);
procedure DoorTextBackground(AColour: Byte);
procedure DoorTextColour(AColour: Byte);
procedure DoorTextColourAndBlink(AColour: Byte; ABlink: Boolean);
procedure DoorWrite(AText: String);
procedure DoorWriteCentered(AText: String);
procedure DoorWriteLn;
procedure DoorWriteLn(AText: String);
implementation
var
OldExitProc: Pointer;
STDIO: Boolean;
procedure DoorDoEvents; forward;
procedure NewExitProc; forward;
{
Default action to take when user drops carrier
}
procedure DefaultOnHangup;
begin
TextAttr := 15;
ClrScr;
WriteLn;
WriteLn(' Caller Dropped Carrier. Returning To BBS...');
Delay(2500);
Halt;
end;
{
Default action to take when /L is used on the command-line
}
procedure DefaultOnLocalLogin;
var
S: String;
begin
DoorTextAttr(7);
DoorClrScr;
DoorWriteLn;
DoorWriteLn;
DoorWriteLn(' |1F LOCAL LOGIN - FOR NODE ' + IntToStr(DoorDropInfo.Node) + '|07');
DoorWriteLn;
DoorWriteLn;
DoorWriteLn(' |09Run ' + ExtractFileName(ParamStr(0)) + ' /? for command-line usage help|07');
DoorWriteLn;
repeat
DoorWrite(' |0AName or handle |0F:|07 ');
S := DoorInput('SYSOP', DOOR_INPUT_CHARS_ALPHA + ' ', #0, 40, 40, 31);
until (S <> '');
DoorDropInfo.RealName := S;
DoorDropInfo.Alias := S;
end;
{
Default status bar displays
}
procedure DefaultOnStatusBar;
begin
FastWrite(#254 + ' ' + #254 + ' ' + #254 + ' ' + #254 + ' ' + #254, 1, 25, 30);
FastWrite(PadRight(DoorDropInfo.RealName, 22), 3, 25, 31);
FastWrite(DoorProgramNameAndVersion, 31, 25, 31);
FastWrite(PadRight('Idle: ' + SecToMS(SecondsBetween(Now, DoorLastKey.Time)), 11), 51, 25, 31);
FastWrite('Left: ' + SecToHMS(DoorSecondsLeft), 65, 25, 31);
end;
{
Default action to take when the user idles too long
}
procedure DefaultOnTimeOut;
begin
DoorTextAttr(15);
DoorClrScr;
DoorWriteLn;
DoorWriteLn(' Idle Time Limit Exceeded. Returning To BBS...');
Delay(2500);
Halt;
end;
{
Default action to take when the user runs out of time
}
procedure DefaultOnTimeUp;
begin
DoorTextAttr(15);
DoorClrScr;
DoorWriteLn;
DoorWriteLn(' Your Time Has Expired. Returning To BBS...');
Delay(2500);
Halt;
end;
{
Default command-line help screen
}
procedure DefaultOnUsage;
begin
// TODO Only display dropfiles that the current platform supports
ClrScr;
WriteLn;
WriteLn(' USAGE: ' + ExtractFileName(ParamStr(0)) + ' <PARAMETERS>');
WriteLn;
WriteLn(' Load settings from a dropfile (DOOR32.SYS, DOOR.SYS, DORINFO*.DEF or INFO.*)');
WriteLn(' -D PATH\FILENAME OF DROPFILE');
WriteLn(' Example: ' + ExtractFileName(ParamStr(0)) + ' -DC:\BBS\NODE1\DOOR32.SYS');
WriteLn;
WriteLn(' Pass settings on command-line');
WriteLn(' -N NODE NUMBER');
WriteLn(' -S SOCKET HANDLE');
WriteLn(' Example: ' + ExtractFileName(ParamStr(0)) + ' -N1 -S1000');
WriteLn;
WriteLn(' Run in local mode');
WriteLn(' -L LOCAL MODE');
WriteLn(' Example: ' + ExtractFileName(ParamStr(0)) + ' -L');
WriteLn;
WriteLn(' Optional parameters');
//TODO WriteLn(' -W WINSERVER DOOR32 MODE');
WriteLn(' -X DISABLE COMM ROUTINES (STDIO MODE)');
WriteLn(' -Z DISABLE LOCAL INPUT');
WriteLn;
Halt;
end;
{
Returns TRUE unless the user has dropped carrier
}
function DoorCarrier: Boolean;
begin
Result := DoorLocal OR STDIO OR CommCarrier;
end;
procedure DoorClose(ADisconnect: Boolean);
begin
if Not(DoorLocal) AND NOT(STDIO) then CommClose(ADisconnect);
end;
{
Clears the entire screen and puts the cursor at (1, 1)
}
procedure DoorClrScr;
begin
DoorWrite(AnsiClrScr);
end;
{
Move the cursor down ACOUNT lines without changing the X position
}
procedure DoorCursorDown(ACount: Byte);
begin
DoorWrite(AnsiCursorDown(ACount));
end;
{
Move the cursor left ACOUNT columns without changing the Y position
}
procedure DoorCursorLeft(ACount: Byte);
begin
DoorWrite(AnsiCursorLeft(ACount));
end;
{
Restore the cursor position which was previously saved with mCursorSave
}
procedure DoorCursorRestore;
begin
DoorWrite(AnsiCursorRestore);
end;
{
Move the cursor right ACOUNT columns without changing the Y position
}
procedure DoorCursorRight(ACount: Byte);
begin
DoorWrite(AnsiCursorRight(ACount));
end;
{
Move the cursor up ACOUNT lines without changing the X position
}
procedure DoorCursorUp(ACount: Byte);
begin
DoorWrite(AnsiCursorUp(ACount));
end;
{
Save the current cursor position. Restore it later with mCursorRestore
}
procedure DoorCursorSave;
begin
DoorWrite(AnsiCursorSave);
end;
{
DoorKeyPressed calls this procedure every time it is run. This is where
a lot of the "behind the scenes" stuff happens, such as determining how
much time the user has left, if theyve dropped carrier, and updating the
status bar.
It is not recommended that you mess with anything in this procedure
}
procedure DoorDoEvents;
begin
if (DoorSession.Events) and (SecondsBetween(Now, DoorSession.EventsTime) >= 1) then
begin
{Check For Hangup}
if Not(DoorCarrier) and Assigned(DoorOnHangup) then DoorOnHangup;
{Check For Idle Timeout}
if (DoorSession.DoIdleCheck) and (DoorSecondsIdle > DoorSession.MaxIdle) and Assigned(DoorOnTimeOut) then DoorOnTimeOut;
{Check For Idle Timeout Warning}
if (DoorSession.DoIdleCheck) and ((DoorSession.MaxIdle - DoorSecondsIdle) mod 60 = 1) and ((DoorSession.MaxIdle - DoorSecondsIdle) div 60 <= 5) and (Assigned(DoorOnTimeOutWarning)) then DoorOnTimeOutWarning((DoorSession.MaxIdle - DoorSecondsIdle) div
60);
{Check For Time Up}
if (DoorSecondsLeft < 1) and Assigned(DoorOnTimeUp) then DoorOnTimeUp;
{Check For Time Up Warning}
if (DoorSecondsLeft mod 60 = 1) and (DoorSecondsLeft div 60 <= 5) and Assigned(DoorOnTimeUpWarning) then DoorOnTimeUpWarning(DoorSecondsLeft div 60);
{Update Status Bar}
if Assigned(DoorOnStatusBar) AND NOT(DoorLocal) AND NOT(STDIO) then DoorOnStatusBar;
DoorSession.EventsTime := Now;
end;
end;
{
Display a file to screen
}
procedure DoorDisplayFile(AFilename: String);
var
InFile: TextFile;
S: String;
begin
// Set the name of the file that will be read
AssignFile(InFile, AFilename);
// Embed the file handling in a try/except block to handle errors gracefully
try
// Open the file for reading
Reset(InFile);
// Keep reading lines until the end of the file is reached
while not Eof(InFile) do
begin
ReadLn(InFile, S);
DoorWrite(S);
if Not(Eof(InFile)) then DoorWriteLn;
end;
// Done so close the file
CloseFile(InFile);
except
on E: EInOutError do
begin
DoorWriteLn('Error reading "' + AFilename + '": ' + E.Message);
DoorWriteLn('Hit a key to continue');
DoorReadKey;
end;
end;
end;
{
Display a sixel file to screen
}
procedure DoorDisplaySixel(AFilename: String);
var
OldLocalWrite: Boolean;
begin
// Sixel files look like garbage when displayed to the local screen, and it's
// also super slow (~5 seconds to display a small 35k image), so we temporarily
// disable local writing before calling the DoorDisplayFile method
AnsiWriteLn('Displaying sixel file: ' + AFilename);
OldLocalWrite := DoorSession.LocalWrite;
DoorSession.LocalWrite := false;
// Display the file
DoorDisplayFile(AFilename);
// Restore LocalWrite flag
DoorSession.LocalWrite := OldLocalWrite;
end;
{
Go to column AX on the current line
}
procedure DoorGotoX(AX: Byte);
begin
DoorWrite(AnsiGotoX(AX));
end;
{
Go to column AX and line AY on the current screen
}
procedure DoorGotoXY(AX, AY: Byte);
begin
DoorWrite(AnsiGotoXY(AX, AY));
end;
{
Go to line AY on the current column
}
procedure DoorGotoY(AY: Byte);
begin
DoorWrite(AnsiGotoY(AY));
end;
{
A fancy input routine
ADefaultText - The text initially displayed in the edit box
AAllowedCharacters - The characters ALLOWED to be part of the string
Look in MSTRINGS.PAS for some defaults
APasswordCharacter - The password character shown instead of the actual text
Use #0 if you dont want to hide the text
AVisibleLength - The number of characters big the edit box should be on screen
AMaxLength - The number of characters the edit box should allow
AMaxLen can be larger than AShowLen, it will just scroll
if that happens.
AAttr - The text attribute of the editbox's text and background
Use formula Attr = Foreground + (Background * 16)
If the user pressed ESCAPE then ADefaultText is returned. If they hit enter
the current string is returned. They cannot hit enter on a blank line.
}
function DoorInput(ADefaultText, AAllowedCharacters: String; APasswordCharacter: Char; AVisibleLength, AMaxLength, AAttr: Byte): String;
var
Ch: Char;
S: String;
SavedAttr: Byte;
XPos: Byte;
procedure UpdateText;
begin
DoorGotoX(XPos);
if (Length(S) > AVisibleLength) then
begin
if (APasswordCharacter = #0) then
begin
DoorWrite(Copy(S, Length(S) - AVisibleLength + 1, AVisibleLength))
end else
begin
DoorWrite(AddCharR(APasswordCharacter, '', AVisibleLength));
end;
DoorGotoX(XPos + AVisibleLength);
end else
begin
if (APasswordCharacter = #0) then
begin
DoorWrite(S)
end else
begin
DoorWrite(AddCharR(APasswordCharacter, '', Length(S)));
end;
DoorWrite(PadRight('', AVisibleLength - Length(S)));
DoorGotoX(XPos + Length(S));
end;
end;
begin
if (Length(ADefaultText) > AMaxLength) then ADefaultText := Copy(ADefaultText, 1, AMaxLength);
S := ADefaultText;
SavedAttr := TextAttr;
DoorTextAttr(AAttr);
XPos := WhereX;
UpdateText;
repeat
Ch := DoorReadKey;
if (Ch = #8) and (Length(S) > 0) then
begin
Delete(S, Length(S), 1);
DoorWrite(#8 + ' ' + #8);
if (Length(S) >= AVisibleLength) then UpdateText;
end else
if (Ch = #25) and (S <> '') then {CTRL-Y}
begin
S := '';
UpdateText;
end else
if (Pos(Ch, AAllowedCharacters) > 0) and (Length(S) < AMaxLength) then
begin
S := S + Ch;
if (Length(S) > AVisibleLength) then
begin
UpdateText
end else
if (APasswordCharacter = #0) then
begin
DoorWrite(Ch)
end else
begin
DoorWrite(APasswordCharacter);
end;
end;
until (Ch = #27) or (Ch = #13);
DoorTextAttr(SavedAttr);
DoorWriteLn;
if (Ch = #27) then S := ADefaultText;
Result := S;
end;
{
Returns TRUE if a character is waiting to be read
Also calls DoEvents to make sure the "dirty work" is handled
}
function DoorKeyPressed: Boolean;
begin
DoorDoEvents;
Result := false;
if (DoorSession.LocalRead) then Result := Result OR KeyPressed;
if Not(DoorLocal) AND NOT(STDIO) then Result := Result OR CommCharAvail;
end;
function DoorLiteBar(APageSize: Integer): Boolean;
var
Ch: Char;
I: Integer;
begin
// Assume success
Result := True;
// Output options
DoorTextAttr(15);
DoorCursorSave;
for I := 0 to DoorLiteBarOptions.Count - 1 do
begin
// Only output as many items as requested
if (I = APageSize) then Break;
if (I > 0) then
begin
DoorCursorRestore;
DoorCursorDown(I);
end;
if (I = DoorLiteBarIndex) then DoorTextBackground(Crt.Blue);
DoorWrite(DoorLiteBarOptions[I]);
DoorTextAttr(15);
end;
// Get response
repeat
Ch := UpCase(DoorReadKey);
case Ch of
'8', '4', 'H', 'K':
begin
// TODO Once scrolling to next page is enabled, allow scrolling to previous page
if (DoorLiteBarIndex > 0) then
begin
// Erase old highlight
DoorCursorRestore;
if (DoorLiteBarIndex > 0) then DoorCursorDown(DoorLiteBarIndex);
DoorWrite(DoorLiteBarOptions[DoorLiteBarIndex]);
DoorTextAttr(15);
// Move up
DoorLiteBarIndex := DoorLiteBarIndex - 1;
// Draw new highlight
DoorCursorRestore;
if (DoorLiteBarIndex > 0) then DoorCursorDown(DoorLiteBarIndex);
DoorTextBackground(Crt.BLUE);
DoorWrite(DoorLiteBarOptions[DoorLiteBarIndex]);
DoorTextAttr(15);
end;
end;
'6', '2', 'M', 'P':
begin
// TODO Allow scrolling to the next page
if ((DoorLiteBarIndex < (APageSize - 1)) AND (DoorLiteBarIndex < (DoorLiteBarOptions.Count - 1))) then
begin
// Erase old highlight
DoorCursorRestore;
if (DoorLiteBarIndex > 0) then DoorCursorDown(DoorLiteBarIndex);
DoorWrite(DoorLiteBarOptions[DoorLiteBarIndex]);
DoorTextAttr(15);
// Move up
DoorLiteBarIndex := DoorLiteBarIndex + 1;
// Draw new highlight
DoorCursorRestore;
if (DoorLiteBarIndex > 0) then DoorCursorDown(DoorLiteBarIndex);
DoorTextBackground(Crt.BLUE);
DoorWrite(DoorLiteBarOptions[DoorLiteBarIndex]);
DoorTextAttr(15);
end;
end;
'Q':
begin
Result := False;
Break;
end;
end;
until (Ch = #13);
DoorCursorRestore;
end;
{
Returns TRUE if the door is being run in local mode
}
function DoorLocal: Boolean;
begin
Result := DoorDropInfo.ComType = 0;
end;
{
Returns TRUE if it was able to open an existing connection
mStartUp calls this, so you should never have to directly
}
function DoorOpenComm: Boolean;
{$IFDEF WIN32_TODO_WINSERVER}
var
WC5User: TWC5User;
{$ENDIF}
begin
if (DoorDropInfo.ComNum = 0) or (DoorDropInfo.ComType = 0) OR (STDIO) then
begin
DoorOpenComm := true;
end else
begin
CommOpen(DoorDropInfo.ComNum);
DoorOpenComm := CommCarrier;
{$IFDEF WIN32_TODO_WINSERVER}
if (DropInfo.ComType = 3) then
begin
if (InitWC5) then
begin
if (WC5_WildcatLoggedIn^(WC5User) = 1) then
begin
DropInfo.RealName := WC5User.Info.Name;
DropInfo.Alias := GetFName(WC5User.Info.Name);
DropInfo.MaxTime := WC5User.TimeLeftToday * 60;
if (WC5User.TerminalType = 0) then
DropInfo.Emulation := etANSI
else
DropInfo.Emulation := etASCII;
DropInfo.Node := WC5_GetNode^();
end else
mOpen := False;
end else
mOpen := False;
end;
{$ENDIF}
end;
end;
{
Returns the next character in the input buffer and updates the TLastKey
record.
}
function DoorReadKey: Char;
var
Ch: Char;
I: Integer;
begin
Ch := #0;
DoorLastKey.Location := lkNone;
repeat
while Not(DoorKeyPressed) do Sleep(1);
if (DoorSession.LocalRead AND KeyPressed) then
begin
// Check for local keypress
Ch := ReadKey;
if (Ch = #0) then
begin
Ch := ReadKey;
if (Not(Assigned(DoorOnSysopKey)) OR (Not(DoorOnSysopKey(Ch)))) then
begin
DoorLastKey.Extended := True;
DoorLastKey.Location := lkLocal;
end;
end else
begin
DoorLastKey.Extended := False;
DoorLastKey.Location := lkLocal;
end;
end else
if Not(DoorLocal) AND NOT(STDIO) AND (CommCharAvail) then
begin
// Check for remote keypress
Ch := CommReadChar;
if (Ch = #27) then
begin
// ESC, could be a special key
// Wait up to 500ms for a second key
for I := 1 to 10 do
begin
if Not(CommCharAvail) then Sleep(50);
end;
// Read the next key, if we have one
if (CommCharAvail) then
begin
if (CommPeekChar = '[') then
begin
// That's ESC and [ now, so we'll assume it's a special key
CommReadChar; // Eat the [
// Wait up to 500ms for a second key
for I := 1 to 10 do
begin
if Not(CommCharAvail) then Sleep(50);
end;
if (CommCharAvail) then
begin
Ch := CommReadChar;
case Ch of
'A': begin
Ch := 'H'; // Up arrow
DoorLastKey.Extended := True;
DoorLastKey.Location := lkRemote;
end;
'B': begin
Ch := 'P'; // Down arrow
DoorLastKey.Extended := True;
DoorLastKey.Location := lkRemote;
end;
'C': begin
Ch := 'M'; // Right arrow
DoorLastKey.Extended := True;
DoorLastKey.Location := lkRemote;
end;
'D': begin
Ch := 'K'; // Left arrow
DoorLastKey.Extended := True;
DoorLastKey.Location := lkRemote;
end;
end;
end else
begin
// ESC and [ with no other key, weird combo to hit manually so we'll ignore it
end;
end else
begin
// Looks like it was ESC followed by something else
DoorLastKey.Extended := False;
DoorLastKey.Location := lkRemote;
end;
end else
begin
// No next key, guess it was just an escape keypress
DoorLastKey.Extended := False;
DoorLastKey.Location := lkRemote;
end;
end else
begin
DoorLastKey.Extended := False;
DoorLastKey.Location := lkRemote;
end;
end;
until (DoorLastKey.Location <> lkNone);
DoorLastKey.Ch := Ch;
DoorLastKey.Time := Now;
Result := Ch;
end;
{
Returns the number of seconds the user has been idle
}
function DoorSecondsIdle: LongInt;
begin
Result := SecondsBetween(Now, DoorLastKey.Time);
end;
{
Returns the number of seconds the user has left this session
}
function DoorSecondsLeft: LongInt;
begin
Result := DoorDropInfo.MaxSeconds - SecondsBetween(Now, DoorSession.TimeOn);
end;
procedure DoorShutDown;
begin
DoorClose(false);
DoorLiteBarOptions.Free;
end;
{
This is the first call your door should make before making any other call
to procedures in this unit. It will parse the command line and take
action depending on the parameters it receives.
If a dropfile is to be read, it will happen automatically.
If the program is not being run in local mode, the existing connection
to the remote user will be opened.
}
procedure DoorStartUp;
var
Ch: Char;
DropFile: String;
Socket: LongInt;
I: Integer;
Local: Boolean;
Node: Integer;
S: String;
Wildcat: Boolean;
begin
DropFile := '';
Local := True;
Node := 0;
Socket := -1;
STDIO := False;
Wildcat := False;
if (ParamCount > 0) then
begin
for I := 1 to ParamCount do
begin
S := ParamStr(I);
if (Length(S) >= 2) and (S[1] in ['/', '-']) then
begin
Ch := UpCase(S[2]);
Delete(S, 1, 2);
Case UpCase(Ch) of
'?': Local := False;
'D': begin
Local := False;
DropFile := S;
end;
'N': Node := StrToIntDef(S, 0);
'S': begin
Local := False;
Socket := StrToIntDef(S, -1);
end;
{$IFDEF WIN32}
'W': begin
Local := False;
Wildcat := True;
end;
{$ENDIF}
'X': STDIO := True;
'Z': DoorSession.LocalRead := False;
else if Assigned(DoorOnCLP) then DoorOnCLP(Ch, S);
end;
end;
end;
end;
if (Local) then
begin
DoorDropInfo.Node := Node;
if Assigned(DoorOnLocalLogin) then
begin
DoorOnLocalLogin;
DoorClrScr;
end;
end else
if (Wildcat) then
begin
DoorDropInfo.ComNum := 1;
DoorDropInfo.ComType := 3;
end else
if (Socket >= 0) and (Node > 0) then
begin
DoorDropInfo.ComNum := Socket;
DoorDropInfo.ComType := 2;
DoorDropInfo.Node := Node;
end else
if (DropFile <> '') then
begin
if (FileExists(DropFile)) and (AnsiContainsText(DropFile, 'DOOR32.SYS')) then
begin
ReadDoor32(DropFile);
end else
if (FileExists(DropFile)) and (AnsiContainsText(DropFile, 'DOOR.SYS')) then
begin
ReadDoorSys(DropFile);
end else
if (FileExists(DropFile)) and (AnsiContainsText(DropFile, 'DORINFO')) then
begin
ReadDorinfo(DropFile);
end else
if (FileExists(DropFile)) and (AnsiContainsText(DropFile, 'INFO.')) then
begin
ReadLordInfo(DropFile);
end else
begin
ClrScr;
WriteLn;
WriteLn(' Drop File Does Not Exist Or Is Not Supported:');
WriteLn(' ' + DropFile);
WriteLn;
Delay(2500);
Halt;
end;
end else
begin
if Assigned(DoorOnUsage) then DoorOnUsage;
Halt;
end;
DoorLastKey.Time := Now;
DoorSession.TimeOn := Now;
if Not(DoorLocal) then
begin
if Not(DoorOpenComm) then
begin
ClrScr;
WriteLn;
WriteLn(' No Carrier Detected');
WriteLn;
Delay(2500);
Halt;
end;
// Setup exit proc, which ensures the comm is closed properly
OldExitProc := ExitProc;
ExitProc := @NewExitProc;
// Indicate we want events to happen (timeout and timeup check, status bar, etc)
DoorSession.Events := True;
DoorSession.EventsTime := 0;
DoorClrScr;
Window(1, 1, 80, 24);
end;
end;
{
Returns TRUE if the door is being run in STDIO mode
}
function DoorSTDIO: Boolean;
begin
Result := STDIO;
end;
{
Change the current text foreground and background to AAttr
Formula: Attr = Foreground + (Background * 16)
}
procedure DoorTextAttr(AAttr: Byte);
begin
DoorWrite(AnsiTextAttr(AAttr));
end;
{
Change the current text background to AColour
}
procedure DoorTextBackground(AColour: Byte);
begin
DoorWrite(AnsiTextBackground(AColour));
end;
{
Change the current text colour to AColour
}
procedure DoorTextColour(AColour: Byte);
begin
DoorWrite(AnsiTextColour(AColour));
end;