1 { $O+,F+,I-,S-,R-,V-}
2 Unit MKGlobT;
3
4 {$IfDef FPC}
5 {$PackRecords 1}
6 {$EndIf}
7
8 Interface
9
10 Uses Dos;
11
12 type
13 OldAddrType = record
14 zone,
15 net,
16 node,
17 point : word;
18 end;
19
20 PAddr = ^AddrType;
21 AddrType = record {Used for Fido style addresses}
22 zone,
23 net,
24 node,
25 point : word;
26 domain : string[20];
27 end;
28 Type SecType = Record
29 Level: Word; {Security level}
30 Flags: LongInt; {32 bitmapped flags}
31 End;
32
33 Type MKDateType = Record
34 Year: Word;
35 Month: Word;
36 Day: Word;
37 End;
38
39 Type MKDateTime = Record
40 Year: Word;
41 Month: Word;
42 Day: Word;
43 Hour: Word;
44 Min: Word;
45 Sec: Word;
46 End;
47
48 Const
49 uoNotAvail = 0;
50 uoBrowse = 1;
51 uoXfer = 2;
52 uoMsg = 3;
53 uoDoor = 4;
54 uoChat = 5;
55 uoQuest = 6;
56 uoReady = 7;
57 uoMail = 8;
58 uoWait = 9;
59 uoLogIn = 10;
60
AddrStrnull61 Function AddrStr(Addr: AddrType): String;
62 procedure ParseAddr(AStr: String; Var DestAddr: AddrType);
DomainlessAddrStrnull63 Function DomainlessAddrStr(Addr: AddrType): String;
PointlessAddrStrnull64 Function PointlessAddrStr(Var Addr: AddrType): String;
CompAddrnull65 function CompAddr(a1, a2: addrtype): byte;
IsValidAddrnull66 Function IsValidAddr(Addr: AddrType): Boolean;
Accessnull67 Function Access(USec: SecType; RSec: SecType): Boolean;
EstimateXferTimenull68 Function EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
69 {Result in seconds}
NameCrcCodenull70 Function NameCrcCode(Str: String): LongInt; {Get CRC code for name}
Flag2Strnull71 Function Flag2Str(Number: Byte): String;
Str2Flagnull72 Function Str2Flag(St: String): Byte;
ValidMKDatenull73 Function ValidMKDate(DT: MKDateTime): Boolean;
74 {$IFDEF WINDOWS}
75 Procedure DT2MKDT(Var DT: TDateTime; Var DT2: MKDateTime);
76 Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: TDateTime);
77 {$ELSE}
78 Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
79 Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
80 {$ENDIF}
81 Procedure Str2MKD(St: String; Var MKD: MKDateType);
MKD2Strnull82 Function MKD2Str(MKD: MKDateType): String;
AddrEqualnull83 Function AddrEqual(Addr1: AddrType; Addr2: AddrType):Boolean;
84
85 Var
86 StartUpPath: String[128];
87
88 Const
89 UseEms: Boolean = True;
90 LocalMode: Boolean = False;
91 LogToPrinter: Boolean = False;
92 ReLoad: Boolean = False;
93 NodeNumber: Byte = 1;
94 OverRidePort: Byte = 0;
95 OverRideBaud: Word = 0;
96 UserBaud: Word = 0;
97 ExitErrorLevel: Byte = 0;
98 TimeToEvent: LongInt = 0;
99 ShellToMailer: Boolean = False;
100
101 Implementation
102
103 Uses MKString, Crc32, MKMisc;
104
105
Flag2Strnull106 Function Flag2Str(Number: Byte): String;
107 Var
108 Temp1: Byte;
109 Temp2: Byte;
110 i: Word;
111 TempStr: String[8];
112
113 Begin
114 Temp1 := 0;
115 Temp2 := $01;
116 For i := 1 to 8 Do
117 Begin
118 If (Number and Temp2) <> 0 Then
119 TempStr[i] := 'X'
120 Else
121 TempStr[i] := '-';
122 Temp2 := Temp2 shl 1;
123 End;
124 TempStr[0] := #8;
125 Flag2Str := TempStr;
126 End;
127
128
Str2Flagnull129 Function Str2Flag(St: String): Byte;
130 Var
131 i: Word;
132 Temp1: Byte;
133 Temp2: Byte;
134
135 Begin
136 St := StripBoth(St,' ');
137 St := PadLeft(St,'-',8);
138 Temp1 := 0;
139 Temp2 := $01;
140 For i := 1 to 8 Do
141 Begin
142 If UpCase(St[i]) = 'X' Then
143 Inc(Temp1,Temp2);
144 Temp2 := Temp2 shl 1;
145 End;
146 Str2Flag := Temp1;
147 End;
148
149
150
151 { vergleich zweier adressen (wilcars "*" erlaubt!) - (c)sl }
CompAddrnull152 function CompAddr(a1, a2: addrtype): byte;
153 var
154 e : byte;
155 begin
156 e := 0;
157 if a1.zone = 0 then
158 begin
159 a1.zone := a2.zone;
160 inc(e);
161 end;
162 if a1.net = 0 then
163 begin
164 a1.net := a2.net;
165 inc(e);
166 end;
167 if a1.node = 0 then
168 begin
169 a1.node := a2.node;
170 inc(e);
171 end;
172 if a1.point = 0 then
173 begin
174 a1.point := a2.point;
175 inc(e);
176 end;
177 if not ((a1.zone = a2.zone) and
178 (a1.node = a2.node) and
179 (a1.net = a2.net) and
180 (a1.point = a2.point)) then e := 255;
181 CompAddr := e;
182 end;
183
AddrStrnull184 Function AddrStr(Addr: AddrType): String;
185 var
186 temp : string[40];
187 begin
188 if Addr.Point = 0 then
189 begin
190 temp := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' + Long2Str(Addr.Node)
191 end
192 else
193 begin
194 temp := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' + Long2Str(Addr.Node) + '.' + Long2Str(Addr.Point);
195 end;
196 if Addr.domain <> '' then temp := temp + '@' + Addr.domain;
197 AddrStr := temp;
198 end;
199
DomainlessAddrStrnull200 Function DomainlessAddrStr(Addr: AddrType): String;
201 begin
202 if Addr.Point = 0 then
203 begin
204 DomainlessAddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' + Long2Str(Addr.Node)
205 end
206 else
207 begin
208 DomainlessAddrStr :=
209 Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' + Long2Str(Addr.Node) + '.' + Long2Str(Addr.Point);
210 end;
211 end;
212
PointlessAddrStrnull213 Function PointlessAddrStr(Var Addr: AddrType): String;
214 begin
215 PointlessAddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' + Long2Str(Addr.Node);
216 end;
217
Accessnull218 Function Access(USec: SecType; RSec: SecType): Boolean;
219 Begin
220 If (USec.Level >= RSec.Level) Then
221 Access := ((RSec.Flags and Not(USec.Flags)) = 0)
222 Else
223 Access := False;
224 End;
225
226
EstimateXferTimenull227 Function EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
228 Begin
229 If BaudRate > 0 Then
230 EstimateXferTime := ((FS * 100) Div Effic) Div (BaudRate Div 10)
231 Else
232 EstimateXferTime := ((FS * 100) Div Effic) Div (960);
233 End;
234
235
NameCrcCodenull236 Function NameCrcCode(Str: String): LongInt;
237 Var
238 NCode: LongInt;
239 i: WOrd;
240
241 Begin
242 NCode := UpdC32(Length(Str),$ffffffff);
243 i := 1;
244 While i < Length(Str) Do
245 Begin
246 NCode := Updc32(Ord(UpCase(Str[i])), NCode);
247 Inc(i);
248 End;
249 NameCrcCode := NCode;
250 End;
251
252
253 procedure ParseAddr(AStr: String; Var DestAddr: AddrType);
254 var
255 p: byte;
256 begin
257 fillchar(destaddr, sizeof(destaddr), 0);
258 AStr := StripBoth(AStr, ' ');
259
260 p := pos('@', AStr);
261 if p > 0 then
262 begin
263 DestAddr.domain := copy(astr, p + 1, 255);
264 astr := copy(astr, 1, p - 1);
265 end;
266
267 p := pos(':', astr);
268 if p > 0 then
269 begin
270 destaddr.zone := str2long(copy(astr, 1, p - 1));
271 astr := copy(astr, p + 1, 255)
272 end;
273
274 p := pos('/', astr);
275 if p > 0 then
276 begin
277 destaddr.net := str2long(copy(astr, 1, p - 1));
278 astr := copy(astr, p + 1, 255)
279 end;
280
281 p := pos('.', astr);
282
283 if p = 0 then p := 255;
284 destaddr.node := str2long(copy(astr, 1, p - 1));
285 astr := copy(astr, p + 1, 255);
286
287 if p <> 255 then
288 begin
289 destaddr.point := str2long(copy(astr, 1, 255));
290 end;
291
292 end;
293
294
295 {$IFDEF WINDOWS}
296 Procedure DT2MKDT(Var DT: TDateTime; Var DT2: MKDateTime);
297 {$ELSE}
298 Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
299 {$ENDIF}
300
301 Begin
302 DT2.Year := DT.Year;
303 DT2.Month := DT.Month;
304 DT2.Day := DT.Day;
305 DT2.Hour := DT.Hour;
306 DT2.Min := DT.Min;
307 DT2.Sec := DT.Sec;
308 End;
309
310
311 {$IFDEF WINDOWS}
312 Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: TDateTime);
313 {$ELSE}
314 Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
315 {$ENDIF}
316
317 Begin
318 DT2.Year := DT.Year;
319 DT2.Month := DT.Month;
320 DT2.Day := DT.Day;
321 DT2.Hour := DT.Hour;
322 DT2.Min := DT.Min;
323 DT2.Sec := DT.Sec;
324 End;
325
326
ValidMKDatenull327 Function ValidMKDate(DT: MKDateTime): Boolean;
328 Var
329 {$IFDEF WINDOWS}
330 DT2: TDateTime;
331 {$ELSE}
332 DT2: DateTime;
333 {$ENDIF}
334
335 Begin
336 MKDT2DT(DT, DT2);
337 ValidMKDate := ValidDate(DT2);
338 End;
339
340
341 Procedure Str2MKD(St: String; Var MKD: MKDateType);
342 Begin
343 FillChar(MKD, SizeOf(MKD), #0);
344 MKD.Year := Str2Long(Copy(St, 7, 2));
345 MKD.Month := Str2Long(Copy(St, 1, 2));
346 MKD.Day := Str2Long(Copy(St, 4, 2));
347 If MKD.Year < 80 Then
348 Inc(MKD.Year, 2000)
349 Else
350 Inc(MKD.Year, 1900);
351 End;
352
353
MKD2Strnull354 Function MKD2Str(MKD: MKDateType): String;
355 Begin
356 MKD2Str := PadLeft(Long2Str(MKD.Month),'0',2) + '-' +
357 PadLeft(Long2Str(MKD.Day), '0',2) + '-' +
358 PadLeft(Long2Str(MKD.Year Mod 100), '0', 2);
359 End;
360
361
AddrEqualnull362 Function AddrEqual(Addr1: AddrType; Addr2: AddrType):Boolean;
363 Begin
364 AddrEqual := ((Addr1.Zone = Addr2.Zone) and (Addr1.Net = Addr2.Net)
365 and (Addr1.Node = Addr2.Node) and (Addr1.Point = Addr2.Point));
366 End;
367
368
369
IsValidAddrnull370 Function IsValidAddr(Addr: AddrType): Boolean;
371 Begin
372 IsValidAddr := ((Addr.Zone = 0) And (Addr.Net = 0));
373 { We have to skip administrative '/0' addresses}
374 End;
375
376
377 End.
378