-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathgf_misc.pas
1461 lines (1291 loc) · 38.9 KB
/
gf_misc.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 gf_misc;
{$I gf_base.inc}
(* ************************************************************
-----------------------------------------------------------
MOZILLA PUBLIC LICENSE STATEMENT
The contents of this file are subject to the Mozilla Public
License Version 1.1 (the "License"); you may not use this file
except in compliance with the License. You may obtain a copy of
the License at http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS
IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
implied. See the License for the specific language governing
rights and limitations under the License.
The Original Code is "gf_misc.pas".
The Initial Developer of the Original Code is Marek Jedlinski
<eristic@lodz.pdi.net> (Poland).
Portions created by Marek Jedlinski are
Copyright (C) 2000, 2001. All Rights Reserved.
-----------------------------------------------------------
Contributor(s):
-----------------------------------------------------------
History:
-----------------------------------------------------------
To do:
-----------------------------------------------------------
Released: 20 August 2001
-----------------------------------------------------------
URLs:
- original author's software site:
http://www.lodz.pdi.net/~eristic/free/index.html
http://go.to/generalfrenetics
Email addresses (at least one should be valid)
<eristic@lodz.pdi.net>
<cicho@polbox.com>
<cicho@tenbit.pl>
************************************************************ *)
interface
uses Classes, SysUtils,
Graphics, Registry,
Windows, ShellAPI,
Messages;
resourcestring
STR_minute = 'minute';
STR_minutes = 'minutes';
STR_hour = 'hour';
STR_hours = 'hours';
STR_day = 'day';
STR_days = 'days';
STR_week = 'week';
STR_weeks = 'weeks';
STR_ERR_OUTOFRESOURCES = 'The operating system is out of memory or resources.';
STR_ERROR_FILE_NOT_FOUND = 'The specified file was not found.';
STR_ERROR_PATH_NOT_FOUND = 'The specified path was not found.';
STR_ERROR_BAD_FORMAT = 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
STR_SE_ERR_ACCESSDENIED = 'The operating system denied access to the specified URL.';
STR_SE_ERR_ASSOCINCOMPLETE = 'The filename association is incomplete or invalid.';
STR_SE_ERR_DDEBUSY = 'The DDE transaction could not be completed because other DDE transactions were being processed.';
STR_SE_ERR_DDEFAIL = 'The DDE transaction failed.';
STR_SE_ERR_DDETIMEOUT = 'The DDE transaction could not be completed because the request timed out.';
STR_SE_ERR_DLLNOTFOUND = 'The specified dynamic-link library was not found.';
STR_SE_ERR_NOASSOC = 'There is no application associated with the given filename extension.';
STR_SE_ERR_OOM = 'There was not enough memory to complete the operation.';
STR_SE_ERR_SHARE = 'A sharing violation occurred';
STR_UNKNOWN_ERROR = 'Unknown error.';
type
String255 = string[255];
String127 = string[127];
String50 = string[50];
String5 = string[5];
SchemeString = string[20];
const
fpRootKey = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
fpFavorites : String50 = 'FAVORITES';
fpPrograms : String50 = 'PROGRAMS';
fpStartup : String50 = 'STARTUP';
fpDesktop : String50 = 'DESKTOP';
fpPersonal : String50 = 'PERSONAL';
const
cnMaxEnvVarValueSize = 250;
BOOLARRAY : array[false..true] of string = ( 'No', 'Yes' );
TOGGLEARRAY : array[false..true] of string = ( 'Off', 'On' );
type
// used for storing user's font preferences in INI files
TFontProperties = packed record
FBGColor : TColor;
FCharset : TFontCharset;
FColor : TColor;
FName : string[32]; //TFontName;
FPitch : TFontPitch;
FSize : integer;
FStyle : TFontStyles;
end;
TStrFontProperties = record
section, fBGColor, fCharset, fColor,
fName, fPitch, fSize, fStyle : string;
end;
const
FontPropertiesIniStr : TStrFontProperties = (
section : 'FontProperties';
fbgcolor : 'BGColor';
fcharset : 'Charset';
fcolor : 'Color';
fname : 'Name';
fpitch : 'Pitch';
fsize : 'Size';
fstyle : 'Style'
);
const
sstrBold = 'bold';
sstrItalic = 'italic';
sstrUnderline = 'underline';
sstrStrikeout = 'strikeout';
type
SetOfTFontStyle = set of TFontStyle;
const
// used to detect if browser is running
MSIEClass1 = 'IEFrame';
MSIEClass2 = 'Internet Explorer_Hidden';
NetscapeClass = 'NetscapeSlaveClass';
type
TTrinaryCompare = ( trinGreater, trinEqual, trinSmaller );
const
partsOfNumbers = '0123456789.,';
digitsNumbers = '0123456789';
function RunsOnWindowsNT : boolean;
function GetCommandInterpreter : string;
function TranslateShellExecuteError( const ErrCode : integer ) : string;
function IsIE4Installed : Boolean;
function TColorToHTMLColor( const cl: TColor): string;
function UnixTimeToDateTime(UnixTime: Integer): TDateTime;
function RFC1123_Date(aDate : TDateTime) : String;
function DoTrinaryCompare( const val1, val2 : longint ) : TTrinaryCompare;
procedure SecondsToHMS( TotalSec : integer; var Hour, Min, Sec : word );
function ShiftStateToHotKey( AState : TShiftState ) : word;
function ShiftStateToStr( const Shift: TShiftState ) : string;
function StrToShiftState( const s : string ) : TShiftState;
function StringIsEmpty( const s : string ) : boolean;
function IsWord( const w : string ) : boolean;
function GetExtAlphChar( aChar : char ) : char;
Function FontStyleToStr( const F : SetOfTFontStyle {TFontProperties} ) : string;
Function StrToFontStyle( S : string ) : SetOfTFontStyle;
function FontPropertiesToStr( const font : TFontProperties ) : string;
procedure SetDefaultFont( var theFont : TFontProperties );
procedure FontPropertiesToFont( const fp : TFontProperties; aFont : TFont );
procedure FontToFontProperties( const aFont : TFont; var fp : TFontProperties );
Function GetAppFromExt( Const Ext : String; const RemoveArgs : boolean ) : String;
function GetFolderPath( const FolderName: String50 ): String;
function StripHTML( s : string; var InTag : boolean ) : string;
procedure BrowsersRunning( var IsNetscape, IsMSIE : boolean );
procedure AssociateApplication( const theEXT, theApp, IconSource : string; const IconIndex : integer );
function GetWindowsPath : string;
function LastPos( AChar : char; const AStr : string ) : integer;
function CtrlDown : Boolean;
function ShiftDown : Boolean;
function AltDown : Boolean;
function GetEnvVar( const csVarName : string ) : string;
function GetTimeZone( var offset, mode : longint ) : boolean;
Function TimeDeltaInMinutes( const StartDate, EndDate : TDateTime): Double;
Function TimeDeltaInSeconds( const StartDate, EndDate : TDateTime): Double;
function DateTimeDiff(Start, Stop : TDateTime) : int64;
function GetTimeIntervalStr(Start, Stop : TDateTime): wideString;
function IncStrInterval (StartDate: TDateTime; const Interval: wideString; increment: boolean= true): TDateTime;
function TimeRevised(time: wideString): WideString;
function NormalFN( const fn : wideString ) : wideString;
function RelativeFN( FN : wideString ) : wideString;
function ProperFolderName( folder : wideString ) : wideString;
function BareFileName( const FN : wideString ) : wideString;
function SlashlessFolderName( const folder : wideString ) : WideString;
function ProperFileName( const FN, folder : wideString ) : wideString;
function AbsoluteFileName( const FN : wideString ) : wideString;
function BoolToStr( const b : boolean ) : string;
function CompareMem( I1, I2: PByte; Size: integer ): boolean;
function DialogFilter( const aName, aMask : string ) : string;
(*
function FormatForHTML( const s : string; const MultiLine : boolean ) : string;
*)
function LongToShortFileName( const FN : String ) : String;
function DateTimeToFileName( const DT : TDateTime ) : string;
function LocalHostName : string;
function MakePercentage( const Step, Max : Longint ) : Longint;
function WindowsErrorString : string;
function DecToRoman( Decimal: Longint): string;
function RomanToDec( const S : string ) : longint;
function RoundTo(n: Extended; decimals: integer): Extended;
function FormatDateTimeEnglish( AFormat : string; ADateTime : TDateTime ) : string;
function GenerateRandomPassphrase(
const UseTemplate : boolean;
const Template : string;
const AllowSpace : boolean;
const MinLength, MaxLength,
RndPassUpAlphW,
RndPassNumW,
RndPassNonAlphW : integer
) : string;
var
_OSIsWindowsNT : boolean;
implementation
uses TntSysUtils, WideStrUtils, DateUtils;
const
TIME_ZONE_ID_UNKNOWN = 0;
TIME_ZONE_ID_STANDARD = 1;
TIME_ZONE_ID_DAYLIGHT = 2;
function GetCommandInterpreter : string;
begin
result := GetEnvVar( 'COMSPEC' );
if ( not fileexists( result )) then
begin
result := 'C:\WinNT\system32\cmd.exe';
if ( not fileexists( result )) then
begin
result := 'C:\Windows\command.com';
if ( not fileexists( result )) then
result := '';
end;
end;
end; // GetCommandInterpreter
procedure SecondsToHMS( TotalSec : integer; var Hour, Min, Sec : word );
begin
Hour := TotalSec div 3600;
dec( TotalSec, Hour*3600 );
Min := TotalSec div 60;
dec( TotalSec, Min*60 );
Sec := TotalSec;
end; // SecondsToHMS
function DoTrinaryCompare( const val1, val2 : longint ) : TTrinaryCompare;
begin
if ( val1 > val2 ) then
result := trinGreater
else
if ( val1 < val2 ) then
result := trinSmaller
else
result := trinEqual;
end;
function ShiftStateToHotKey( AState : TShiftState ) : word;
begin
result := 0;
if ( ssAlt in AState ) then
result := result or MOD_ALT;
if ( ssCtrl in AState ) then
result := result or MOD_CONTROL;
if ( ssShift in AState ) then
result := result or MOD_SHIFT;
end; // ShiftStateToHotKey
function ShiftStateToStr( const Shift: TShiftState ) : string;
begin
result := '';
if ( ssShift in Shift ) then
result := result + 'S';
if ( ssCtrl in Shift ) then
result := result + 'C';
if ( ssAlt in Shift ) then
result := result + 'A';
if ( ssLeft in Shift ) then
result := result + 'L';
if ( ssRight in Shift ) then
result := result + 'R';
if ( ssMiddle in Shift ) then
result := result + 'M';
if ( ssDouble in Shift ) then
result := result + 'D';
end; // ShiftStateToStr
function StrToShiftState( const s : string ) : TShiftState;
begin
result := [];
if pos( 'S', s ) > 0 then
include( result, ssShift );
if pos( 'C', s ) > 0 then
include( result, ssCtrl );
if pos( 'A', s ) > 0 then
include( result, ssAlt );
if pos( 'L', s ) > 0 then
include( result, ssLeft );
if pos( 'R', s ) > 0 then
include( result, ssRight );
if pos( 'M', s ) > 0 then
include( result, ssMiddle );
if pos( 'D', s ) > 0 then
include( result, ssDouble );
end; // StrToShiftState
function StringIsEmpty( const s : string ) : boolean;
var
i : integer;
begin
result := true;
for i := 1 to length( s ) do
begin
// if ( not ( s[i] in [#9, #10, #13, #32] )) then
if ( s[i] > #32 ) then
begin
result := false;
break;
end;
end;
end; // StringIsEmpty
function FontStyleToStr( const F : SetOfTFontStyle ) : string;
begin
result := '';
if fsBold in F then
result := sstrBold +#32;
if fsItalic in F then
result := result + sstrItalic +#32;
if fsUnderline in F then
result := result + sstrUnderline +#32;
if fsStrikeOut in F then
result := result + sstrStrikeOut;
result := trim( result );
end; // FontStyleToStr
function StrToFontStyle( S : string ) : SetOfTFontStyle;
var
F : SetOfTFontStyle;
begin
F := [];
if ( pos( sstrBold, S ) > 0 ) then
include( F, fsBold );
if ( pos( sstrItalic, S ) > 0 ) then
include( F, fsItalic );
if ( pos( sstrUnderline, S ) > 0 ) then
include( F, fsUnderline );
if ( pos( sstrStrikeOut, S ) > 0 ) then
include( F, fsStrikeOut );
result := F;
end; // StrToFontStyle
function GetAppFromExt( const Ext : string; const RemoveArgs : boolean ) : string;
// adapted from Borland FAQ
var
S : string;
p : integer;
begin
s := '';
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
if OpenKey( '\' + Ext, False ) then
begin
S := ReadString( '' );
if S <> '' Then
begin
if OpenKey( '\' + S + '\shell\open\command', False ) then
begin
S := ReadString( '' );
end;
end
else
begin
If OpenKey( '\' + Ext + '\shell\open\command', False ) Then
begin
S := ReadString( '' );
end;
end;
end;
finally
Free;
end;
if (( s <> '' ) and RemoveArgs ) then
begin
p := pos( ' "%1"', s );
if ( p > 0 ) then
delete( s, p, length( s ) );
end;
if ( s <> '' ) then
begin
if ( s[1] = '"' ) then
begin
delete( s, 1, 1 );
delete( s, pos( '"', s ), length( s ));
end;
end;
result := s;
end; // GetAppFromExt
function GetFolderPath( const FolderName : String50 ) : string;
begin
result := '';
with TRegistry.Create do
try
RootKey:= HKEY_CURRENT_USER;
OpenKey( fpRootKey, False );
Result := ReadString( FolderName );
CloseKey;
finally
Free;
end;
end; // GetFolderPath
function StripHTML( s : string; var InTag : boolean ) : string;
// Simplistic, but works where we need it.
// As a general solution, you probably can't do this
// reliably without parsing HTML first
var
posbeg, posend : integer;
temps : string;
begin
temps := '';
if ( length( s ) < 3 ) then
begin
result := s;
exit;
end;
if InTag then
begin
posend := pos( '>', s );
if ( posend = 0 ) then
begin
result := s;
exit;
end;
delete( s, 1, posend );
InTag := false;
end;
posbeg := pos( '<', s );
while ( posbeg > 0 ) do
begin
temps := temps + copy( s, 1, posbeg-1 );
delete( s, 1, posbeg );
InTag := true;
posend := pos( '>', s );
if ( posend = 0 ) then
begin
break;
end
else
begin
delete( s, 1, posend );
InTag := false;
end;
posbeg := pos( '<', s );
end;
if InTag then
result := temps
else
result := temps + s;
end; // StripHTML
procedure BrowsersRunning( var IsNetscape, IsMSIE : boolean );
begin
IsNetscape := ( FindWindow( PChar( NetscapeClass ), nil ) > 0 );
IsMSIE := ( FindWindow( PChar( MSIEClass1 ), nil ) > 0 )
or
( FindWindow( PChar( MSIEClass2 ), nil ) > 0 );
end; // BrowsersRunning
procedure AssociateApplication(
const theEXT, theApp,
IconSource : string;
const IconIndex : integer );
{ adapted from Borland Delphi FAQ }
var
reg : TRegistry;
cmd, icn : string;
begin
cmd := theApp;
if ( pos( #32, cmd ) > 0 ) then
cmd := LongToShortFileName( cmd );
cmd := lowercase( cmd );
if ( IconSource <> '' ) then
icn := IconSource
else
icn := theApp;
if ( pos( #32, icn ) > 0 ) then
icn := LongToShortFileName( icn );
icn := lowercase( icn );
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CLASSES_ROOT;
reg.LazyWrite := false;
reg.OpenKey( theEXT + '\shell\open\command', true );
reg.WriteString('', cmd + ' "%1"');
reg.CloseKey;
reg.OpenKey( theEXT + '\DefaultIcon', true );
reg.WriteString('',
icn + ',' + inttostr( IconIndex ));
reg.CloseKey;
finally
reg.free;
end;
end; // AssociateApplication
function GetWindowsPath : string;
var
folder : array[0..MAX_PATH] of char;
i : integer;
begin
folder := '';
i := GetWindowsDirectory( folder, MAX_PATH );
if ( i <> 0 ) then
result := folder
else
result := '';
end; // GetWindowsPath
function FontPropertiesToStr( const font : TFontProperties ) : string;
begin
result := font.fname + #32 + inttostr( font.fsize ) + ' pt ' + FontStyleToStr( font.fstyle );
end; // FontPropertiesToStr
function BareFileName( const FN : wideString ) : wideString;
var
p : integer;
begin
result := WideExtractFilename( FN );
p := lastpos( '.', result );
if ( p > 0 ) then
delete( result, p, length( result ));
end; // BareFileName
function ProperFolderName( folder : wideString ) : wideString;
begin
folder := widelowercase( trim( folder ));
if ( folder <> '' ) then
begin
if ( folder[length( folder )] <> '\' ) then
folder := folder + '\';
end;
result := folder;
end; // ProperFolderName
function SlashlessFolderName( const folder : wideString ) : wideString;
var
l : integer;
begin
result := folder;
l := length( result );
if ( l > 3 ) then
begin
if ( result[l] = '\' ) then
delete( result, l, 1 );
end;
end; // SlashlessFolderName
function ProperFileName( const FN, folder : wideString ) : wideString;
begin
if ( fn = '' ) then
begin
result := fn;
exit;
end;
if ( extractfilepath( fn ) = '' ) then
begin
if ( folder <> '' ) then
result := properfoldername( folder ) + fn
else
result := properfoldername( ParamStr( 0 )) + fn;
end;
end; // ProperFileName
function LastPos( AChar : char; const AStr : string ) : integer;
var
i : integer;
begin
if ( AStr = '' ) then
begin
result := 0;
exit;
end;
i := length( AStr );
while ( i > 0 ) and ( AStr[i] <> Achar ) do
dec( i );
result := i;
end; // LastPos
procedure SetDefaultFont( var theFont : TFontProperties );
begin
with theFont do
begin
fcharset := DEFAULT_CHARSET; // OEM_CHARSET;
fcolor := clWindowText;
fname := 'Tahoma';
fpitch := fpDefault;
fsize := 10;
fstyle := [];
fBGColor := clWindow;
end;
end; // SetDefaultFont
function CtrlDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Control] And 128) <> 0);
end;
function ShiftDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
end;
function AltDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Menu] and 128) <> 0);
end;
function GetEnvVar( const csVarName : string ) : string;
var
pc2 : PChar;
res : integer;
begin
pc2 := StrAlloc( cnMaxEnvVarValueSize + 1 );
try
res := GetEnvironmentVariable( pchar( csVarName ), pc2, cnMaxEnvVarValueSize );
if ( res > 0 ) then
Result := StrPas( pc2 )
else
result := '';
finally
StrDispose( pc2 );
end;
end; // GetEnvVar
function GetTimeZone( var offset, mode : longint ) : boolean;
var
aTimeZoneInfo : TTimeZoneInformation;
begin
result := false;
mode := GetTimeZoneInformation(aTimeZoneInfo);
if ( mode in [TIME_ZONE_ID_UNKNOWN,TIME_ZONE_ID_STANDARD] ) then
begin
offset := - ( aTimeZoneInfo.Bias DIV 60 );
result := true;
end
else
if ( mode = TIME_ZONE_ID_DAYLIGHT ) then
begin
offset := - (( aTimeZoneInfo.Bias + aTimeZoneInfo.DaylightBias ) DIV 60 );
result := true;
end;
end; // TimeZoneOffset
Function TimeDeltaInMinutes( const StartDate, EndDate : TDateTime): Double;
Var
Hour, Min, Sec, MSec : Word;
Delta : TDateTime;
Begin
Try
Delta := EndDate - StartDate;
DecodeTime(Delta, Hour, Min, Sec, MSec);
Result := (Hour*60)+Min;
Except
Result := 0;
End;
End; // TimeDeltaInMinutes
Function TimeDeltaInSeconds( const StartDate, EndDate : TDateTime): Double;
Var
Hour, Min, Sec, MSec : Word;
Delta : TDateTime;
Begin
Try
Delta := EndDate - StartDate;
DecodeTime(Delta, Hour, Min, Sec, MSec);
Result := (((Hour*60)+Min)*60)+Sec;
Except
Result := 0;
End;
End; // TimeDeltaInSeconds
function DateTimeDiff(Start, Stop : TDateTime) : int64;
var TimeStamp : TTimeStamp;
begin
if Stop >= Start then
TimeStamp := DateTimeToTimeStamp(Stop - Start)
else
TimeStamp := DateTimeToTimeStamp(Start - Stop);
Dec(TimeStamp.Date, TTimeStamp(DateTimeToTimeStamp(0)).Date);
Result := (TimeStamp.Date*24*60*60)+(TimeStamp.Time div 1000);
end;
function RoundTo(n: Extended; decimals: integer): Extended;
var
coef: int64;
begin
coef:= Round(Exp(decimals*ln(10))); // a^b
if n > 0 then
Result:= Trunc(n*coef + 0.5 + 0.00000001) / coef
else
Result:= Trunc(n*coef - 0.5 - 0.00000001) / coef;
end;
function NormalFN( const fn : wideString ) : wideString;
begin
result := FN;
if ( result <> '' ) then
begin
if ( result[1] = '"' ) then
begin
delete( result, 1, 1 );
delete( result, pos( '"', result ), length( result ));
end;
result := trim( result );
(*
if NormalizePath then
begin
if (( result <> '' ) and ( pos( '\', result ) = 0 )) then
result := extractfilepath( ParamStr( 0 )) + result;
end;
*)
end;
//result := ansilowercase( result );
end; // NormalFN
function RelativeFN( FN : wideString ) : wideString;
begin
// given a full path and filename, returns only the
// filename part IF the path is the same as the application's
// own directory (ie the file lives where the program does)
FN := NormalFN( FN );
if ( extractfilepath( FN ) = widelowercase( extractfilepath( ParamStr( 0 )))) then //**** extractFilepath (sysUtils) -> string
result := WideExtractFilename( FN )
else
result := FN;
end; // relativeFN
function AbsoluteFileName( const FN : wideString ) : wideString;
begin
if ( FN = '' ) then
begin
result := '';
exit;
end;
if ( extractfilepath( FN ) = '' ) then
result := normalFN( extractfilepath( paramstr( 0 )) + FN )
else
result := normalFN( FN );
end; // AbsoluteFileName
function BoolToStr( const b : boolean ) : string;
begin
if b then
result := 'Yes'
else
result := 'No';
end; // BoolToStr;
function CompareMem(I1, I2: PByte; Size: integer): boolean;
// compares 2 memory buffers
// Written by David Barton (davebarton@bigfoot.com)
begin
Result:= true;
repeat
if I1^<> I2^ then
begin
Result:= false;
Exit;
end;
Inc(I1);
Inc(I2);
Dec(Size);
until Size= 0;
end; // CompareMem
function DialogFilter( const aName, aMask : string ) : string;
begin
result := aName + ' (' + aMask + ')|' + aMask;
end; // Dialogfilter;
(*
function FormatForHTML( const s : string; const MultiLine : boolean ) : string;
// "s" must NOT contain any HTML tags!
var
i : integer;
ch : char;
begin
result := '';
for i := 1 to length( s ) do
begin
ch := s[i];
case ch of
'&' : begin
result := result + '&';
end;
'<' : begin
result := result + '<';
end;
'>' : begin
result := result + '>';
end;
'"' : begin
result := result + '"';
end;
#13 : begin
if MultiLine then
result := result + '<BR>' + #13#10
else
result := result + #13#10;
end;
#0, #10 : begin
// ignore
end;
else
begin
result := result + ch;
end;
end;
end;
end; // FormatForHTML
*)
procedure FontPropertiesToFont( const fp : TFontProperties; aFont : TFont );
begin
with aFont do
begin
name := fp.fname;
pitch := fp.fpitch;
size := fp.fsize;
color := fp.fcolor;
charset := fp.fcharset;
style := fp.FStyle;
end;
end; // FontPropertiesToFont
procedure FontToFontProperties( const aFont : TFont; var fp : TFontProperties );
begin
with aFont do begin
fp.fname := name;
fp.fpitch := pitch;
fp.fsize := size;
fp.fcolor := color;
fp.fcharset := charset;
fp.fstyle := style;
end;
end; // FontToFontProperties
function LongToShortFileName( const FN : string ) : string;
// returns short (8.3) filename given a long name
// will return garbage if file does not exist, so
// check before. Ideally, it should also accept
// bare filenames and search the PATH first, but
// that would slow us down somewhat/
var
Buffer : array [0..255] of char;
begin
GetShortPathName(
PChar( FN ),
@Buffer,
sizeof(Buffer));
result := Buffer;
end; // LongToShortFileName
function DateTimeToFileName( const DT : TDateTime ) : string;
var
i : integer;
begin
result := DateTimeToStr( DT );
for i := 1 to length( result ) do
begin
if ( result[i] = #32 ) then
result[i] := '_'
else
if ( result[i] = ':' ) then
result[i] := '-';
end;
end; // DateTimeToFileName
function GetExtAlphChar( aChar : char ) : char;
begin
case aChar of
'¹', '¥' : result := 'a';
'æ', 'Æ' : result := 'c';
'ê', 'Ê' : result := 'e';
'³', '£' : result := 'l';
'ñ', 'Ñ' : result := 'n';
'ó', 'Ó' : result := 'o';
'', '' : result := 's';
'', '' : result := 'z';
'¿', '¯' : result := 'z';
else
result := #0;
end;
end; // GetExtAlphChar
function IsWord( const w : string ) : boolean;
var
i : integer;
begin
result := true;
if ( w = '' ) then
begin
result := false;
exit;
end;
for i := 1 to length( w ) do
if not IsCharAlphaA( w[i] ) then
begin
result := false;
break;
end;
end; // IsWord
function LocalHostName : string;
var
s : array[0..128] of char;
size : DWORD;
begin
size := 128;
if GetComputerName( @s, size ) then
result := s
else
result := 'localhost';
end; // LocalHostName
function MakePercentage( const Step, Max : Longint ) : Longint;
begin
Result := Round((Step * 100.0) / Max);
end;
function UnixTimeToDateTime(UnixTime: Integer): TDateTime;
begin
Result := EncodeDate(1970, 1, 1) + (UnixTime div 86400);
Result := Result + ((UnixTime mod 86400) / 86400);
end; // UnixTimeToDateTime
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ We cannot use Delphi own function because the date must be specified in }
{ english and Delphi use the current language. }