source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntSystem.pas@ 1806

Last change on this file since 1806 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 42.8 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntSystem;
13
14{$INCLUDE TntCompilers.inc}
15
16{*****************************************************************************}
17{ Special thanks go to Francisco Leong for originating the design for }
18{ WideString-enabled resourcestrings. }
19{*****************************************************************************}
20
21interface
22
23uses
24 Windows;
25
26// These functions should not be used by Delphi code since conversions are implicit.
27{TNT-WARN WideCharToString}
28{TNT-WARN WideCharLenToString}
29{TNT-WARN WideCharToStrVar}
30{TNT-WARN WideCharLenToStrVar}
31{TNT-WARN StringToWideChar}
32
33// ................ ANSI TYPES ................
34{TNT-WARN Char}
35{TNT-WARN PChar}
36{TNT-WARN String}
37
38{TNT-WARN CP_ACP} // <-- use DefaultSystemCodePage
39function DefaultSystemCodePage: Cardinal; // implicitly used when converting AnsiString <--> WideString.
40
41var
42 WideCustomLoadResString: function(ResStringRec: PResStringRec; var Value: WideString): Boolean;
43
44{TNT-WARN LoadResString}
45function WideLoadResString(ResStringRec: PResStringRec): WideString;
46{TNT-WARN ParamCount}
47function WideParamCount: Integer;
48{TNT-WARN ParamStr}
49function WideParamStr(Index: Integer): WideString;
50
51// ......... introduced .........
52
53const
54 { Each Unicode stream should begin with the code U+FEFF, }
55 { which the standard defines as the *byte order mark*. }
56 UNICODE_BOM = WideChar($FEFF);
57 UNICODE_BOM_SWAPPED = WideChar($FFFE);
58 UTF8_BOM = AnsiString(#$EF#$BB#$BF);
59
60function WideStringToUTF8(const S: WideString): AnsiString;
61function UTF8ToWideString(const S: AnsiString): WideString;
62
63function WideStringToUTF7(const W: WideString): AnsiString;
64function UTF7ToWideString(const S: AnsiString): WideString;
65
66function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
67function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
68
69function UCS2ToWideString(const Value: AnsiString): WideString;
70function WideStringToUCS2(const Value: WideString): AnsiString;
71
72function CharSetToCodePage(ciCharset: UINT): Cardinal;
73function LCIDToCodePage(ALcid: LCID): Cardinal;
74function KeyboardCodePage: Cardinal;
75function KeyUnicode(CharCode: Word): WideChar;
76
77procedure StrSwapByteOrder(Str: PWideChar);
78
79type
80 TTntSystemUpdate =
81 (tsWideResourceStrings
82 {$IFNDEF COMPILER_9_UP}, tsFixImplicitCodePage, tsFixWideStrConcat, tsFixWideFormat {$ENDIF}
83 );
84 TTntSystemUpdateSet = set of TTntSystemUpdate;
85
86const
87 AllTntSystemUpdates = [Low(TTntSystemUpdate)..High(TTntSystemUpdate)];
88
89procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
90
91implementation
92
93uses
94 SysUtils, Variants, TntWindows, TntSysUtils;
95
96var
97 GDefaultSystemCodePage: Cardinal;
98
99function DefaultSystemCodePage: Cardinal;
100begin
101 Result := GDefaultSystemCodePage;
102end;
103
104var
105 IsDebugging: Boolean;
106
107function WideLoadResString(ResStringRec: PResStringRec): WideString;
108const
109 MAX_RES_STRING_SIZE = 4097; { MSDN documents this as the maximum size of a string in table. }
110var
111 Buffer: array [0..MAX_RES_STRING_SIZE] of WideChar; { Buffer leaves room for null terminator. }
112 PCustom: PAnsiChar;
113begin
114 if Assigned(WideCustomLoadResString) and WideCustomLoadResString(ResStringRec, Result) then
115 exit; { a custom resourcestring has been loaded. }
116
117 if ResStringRec = nil then
118 Result := ''
119 else if ResStringRec.Identifier < 64*1024 then
120 SetString(Result, Buffer,
121 Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^),
122 ResStringRec.Identifier, Buffer, MAX_RES_STRING_SIZE))
123 else begin
124 // custom string pointer
125 PCustom := PAnsiChar(ResStringRec.Identifier); { I would like to use PWideChar, but this would break legacy code. }
126 if (StrLen{TNT-ALLOW StrLen}(PCustom) > Cardinal(Length(UTF8_BOM)))
127 and CompareMem(PCustom, PAnsiChar(UTF8_BOM), Length(UTF8_BOM)) then
128 // detected UTF8
129 Result := UTF8ToWideString(PAnsiChar(PCustom + Length(UTF8_BOM)))
130 else
131 // normal
132 Result := PCustom;
133 end;
134end;
135
136function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar;
137var
138 i, Len: Integer;
139 Start, S, Q: PWideChar;
140begin
141 while True do
142 begin
143 while (P[0] <> #0) and (P[0] <= ' ') do
144 Inc(P);
145 if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
146 end;
147 Len := 0;
148 Start := P;
149 while P[0] > ' ' do
150 begin
151 if P[0] = '"' then
152 begin
153 Inc(P);
154 while (P[0] <> #0) and (P[0] <> '"') do
155 begin
156 Q := P + 1;
157 Inc(Len, Q - P);
158 P := Q;
159 end;
160 if P[0] <> #0 then
161 Inc(P);
162 end
163 else
164 begin
165 Q := P + 1;
166 Inc(Len, Q - P);
167 P := Q;
168 end;
169 end;
170
171 SetLength(Param, Len);
172
173 P := Start;
174 S := PWideChar(Param);
175 i := 0;
176 while P[0] > ' ' do
177 begin
178 if P[0] = '"' then
179 begin
180 Inc(P);
181 while (P[0] <> #0) and (P[0] <> '"') do
182 begin
183 Q := P + 1;
184 while P < Q do
185 begin
186 S[i] := P^;
187 Inc(P);
188 Inc(i);
189 end;
190 end;
191 if P[0] <> #0 then Inc(P);
192 end
193 else
194 begin
195 Q := P + 1;
196 while P < Q do
197 begin
198 S[i] := P^;
199 Inc(P);
200 Inc(i);
201 end;
202 end;
203 end;
204
205 Result := P;
206end;
207
208function WideParamCount: Integer;
209var
210 P: PWideChar;
211 S: WideString;
212begin
213 P := WideGetParamStr(GetCommandLineW, S);
214 Result := 0;
215 while True do
216 begin
217 P := WideGetParamStr(P, S);
218 if S = '' then Break;
219 Inc(Result);
220 end;
221end;
222
223function WideParamStr(Index: Integer): WideString;
224var
225 P: PWideChar;
226begin
227 if Index = 0 then
228 Result := WideGetModuleFileName(0)
229 else
230 begin
231 P := GetCommandLineW;
232 while True do
233 begin
234 P := WideGetParamStr(P, Result);
235 if (Index = 0) or (Result = '') then Break;
236 Dec(Index);
237 end;
238 end;
239end;
240
241function WideStringToUTF8(const S: WideString): AnsiString;
242begin
243 Result := UTF8Encode(S);
244end;
245
246function UTF8ToWideString(const S: AnsiString): WideString;
247begin
248 Result := UTF8Decode(S);
249end;
250
251 { ======================================================================= }
252 { Original File: ConvertUTF7.c }
253 { Author: David B. Goldsmith }
254 { Copyright (C) 1994, 1996 Taligent, Inc. All rights reserved. }
255 { }
256 { This code is copyrighted. Under the copyright laws, this code may not }
257 { be copied, in whole or part, without prior written consent of Taligent. }
258 { }
259 { Taligent grants the right to use this code as long as this ENTIRE }
260 { copyright notice is reproduced in the code. The code is provided }
261 { AS-IS, AND TALIGENT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR }
262 { IMPLIED, INCLUDING, BUT NOT LIMITED TO IMPLIED WARRANTIES OF }
263 { MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT }
264 { WILL TALIGENT BE LIABLE FOR ANY DAMAGES WHATSOEVER (INCLUDING, }
265 { WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS }
266 { INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR OTHER PECUNIARY }
267 { LOSS) ARISING OUT OF THE USE OR INABILITY TO USE THIS CODE, EVEN }
268 { IF TALIGENT HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. }
269 { BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF }
270 { LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE ABOVE }
271 { LIMITATION MAY NOT APPLY TO YOU. }
272 { }
273 { RESTRICTED RIGHTS LEGEND: Use, duplication, or disclosure by the }
274 { government is subject to restrictions as set forth in subparagraph }
275 { (c)(l)(ii) of the Rights in Technical Data and Computer Software }
276 { clause at DFARS 252.227-7013 and FAR 52.227-19. }
277 { }
278 { This code may be protected by one or more U.S. and International }
279 { Patents. }
280 { }
281 { TRADEMARKS: Taligent and the Taligent Design Mark are registered }
282 { trademarks of Taligent, Inc. }
283 { ======================================================================= }
284
285type UCS2 = Word;
286
287const
288 _base64: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
289 _direct: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789''(),-./:?';
290 _optional: AnsiString = '!"#$%&*;<=>@[]^_`{|}';
291 _spaces: AnsiString = #9#13#10#32;
292
293var
294 base64: PAnsiChar;
295 invbase64: array[0..127] of SmallInt;
296 direct: PAnsiChar;
297 optional: PAnsiChar;
298 spaces: PAnsiChar;
299 mustshiftsafe: array[0..127] of AnsiChar;
300 mustshiftopt: array[0..127] of AnsiChar;
301
302var
303 needtables: Boolean = True;
304
305procedure Initialize_UTF7_Data;
306begin
307 base64 := PAnsiChar(_base64);
308 direct := PAnsiChar(_direct);
309 optional := PAnsiChar(_optional);
310 spaces := PAnsiChar(_spaces);
311end;
312
313procedure tabinit;
314var
315 i: Integer;
316 limit: Integer;
317begin
318 i := 0;
319 while (i < 128) do
320 begin
321 mustshiftopt[i] := #1;
322 mustshiftsafe[i] := #1;
323 invbase64[i] := -1;
324 Inc(i);
325 end { For };
326 limit := Length(_Direct);
327 i := 0;
328 while (i < limit) do
329 begin
330 mustshiftopt[Integer(direct[i])] := #0;
331 mustshiftsafe[Integer(direct[i])] := #0;
332 Inc(i);
333 end { For };
334 limit := Length(_Spaces);
335 i := 0;
336 while (i < limit) do
337 begin
338 mustshiftopt[Integer(spaces[i])] := #0;
339 mustshiftsafe[Integer(spaces[i])] := #0;
340 Inc(i);
341 end { For };
342 limit := Length(_Optional);
343 i := 0;
344 while (i < limit) do
345 begin
346 mustshiftopt[Integer(optional[i])] := #0;
347 Inc(i);
348 end { For };
349 limit := Length(_Base64);
350 i := 0;
351 while (i < limit) do
352 begin
353 invbase64[Integer(base64[i])] := i;
354 Inc(i);
355 end { For };
356 needtables := False;
357end; { tabinit }
358
359function WRITE_N_BITS(x: UCS2; n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): Integer;
360begin
361 BITbuffer := BITbuffer or (x and (not (-1 shl n))) shl (32 - n - bufferbits);
362 bufferbits := bufferbits + n;
363 Result := bufferbits;
364end; { WRITE_N_BITS }
365
366function READ_N_BITS(n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): UCS2;
367var
368 buffertemp: Cardinal;
369begin
370 buffertemp := BITbuffer shr (32 - n);
371 BITbuffer := BITbuffer shl n;
372 bufferbits := bufferbits - n;
373 Result := UCS2(buffertemp);
374end; { READ_N_BITS }
375
376function ConvertUCS2toUTF7(var sourceStart: PWideChar; sourceEnd: PWideChar;
377 var targetStart: PAnsiChar; targetEnd: PAnsiChar; optional: Boolean;
378 verbose: Boolean): Integer;
379var
380 r: UCS2;
381 target: PAnsiChar;
382 source: PWideChar;
383 BITbuffer: Cardinal;
384 bufferbits: Integer;
385 shifted: Boolean;
386 needshift: Boolean;
387 done: Boolean;
388 mustshift: PAnsiChar;
389begin
390 Initialize_UTF7_Data;
391 Result := 0;
392 BITbuffer := 0;
393 bufferbits := 0;
394 shifted := False;
395 source := sourceStart;
396 target := targetStart;
397 r := 0;
398 if needtables then
399 tabinit;
400 if optional then
401 mustshift := @mustshiftopt[0]
402 else
403 mustshift := @mustshiftsafe[0];
404 repeat
405 done := source >= sourceEnd;
406 if not Done then
407 begin
408 r := Word(source^);
409 Inc(Source);
410 end { If };
411 needshift := (not done) and ((r > $7F) or (mustshift[r] <> #0));
412 if needshift and (not shifted) then
413 begin
414 if (Target >= TargetEnd) then
415 begin
416 Result := 2;
417 break;
418 end { If };
419 target^ := '+';
420 Inc(target);
421 { Special case handling of the SHIFT_IN character }
422 if (r = UCS2('+')) then
423 begin
424 if (target >= targetEnd) then
425 begin
426 Result := 2;
427 break;
428 end;
429 target^ := '-';
430 Inc(target);
431 end
432 else
433 shifted := True;
434 end { If };
435 if shifted then
436 begin
437 { Either write the character to the bit buffer, or pad }
438 { the bit buffer out to a full base64 character. }
439 { }
440 if needshift then
441 WRITE_N_BITS(r, 16, BITbuffer, bufferbits)
442 else
443 WRITE_N_BITS(0, (6 - (bufferbits mod 6)) mod 6, BITbuffer,
444 bufferbits);
445 { Flush out as many full base64 characters as possible }
446 { from the bit buffer. }
447 { }
448 while (target < targetEnd) and (bufferbits >= 6) do
449 begin
450 Target^ := base64[READ_N_BITS(6, BITbuffer, bufferbits)];
451 Inc(Target);
452 end { While };
453 if (bufferbits >= 6) then
454 begin
455 if (target >= targetEnd) then
456 begin
457 Result := 2;
458 break;
459 end { If };
460 end { If };
461 if (not needshift) then
462 begin
463 { Write the explicit shift out character if }
464 { 1) The caller has requested we always do it, or }
465 { 2) The directly encoded character is in the }
466 { base64 set, or }
467 { 3) The directly encoded character is SHIFT_OUT. }
468 { }
469 if verbose or ((not done) and ((invbase64[r] >= 0) or (r =
470 Integer('-')))) then
471 begin
472 if (target >= targetEnd) then
473 begin
474 Result := 2;
475 Break;
476 end { If };
477 Target^ := '-';
478 Inc(Target);
479 end { If };
480 shifted := False;
481 end { If };
482 { The character can be directly encoded as ASCII. }
483 end { If };
484 if (not needshift) and (not done) then
485 begin
486 if (target >= targetEnd) then
487 begin
488 Result := 2;
489 break;
490 end { If };
491 Target^ := AnsiChar(r);
492 Inc(Target);
493 end { If };
494 until (done);
495 sourceStart := source;
496 targetStart := target;
497end; { ConvertUCS2toUTF7 }
498
499function ConvertUTF7toUCS2(var sourceStart: PAnsiChar; sourceEnd: PAnsiChar;
500 var targetStart: PWideChar; targetEnd: PWideChar): Integer;
501var
502 target: PWideChar { Register };
503 source: PAnsiChar { Register };
504 BITbuffer: Cardinal { & "Address Of" Used };
505 bufferbits: Integer { & "Address Of" Used };
506 shifted: Boolean { Used In Boolean Context };
507 first: Boolean { Used In Boolean Context };
508 wroteone: Boolean;
509 base64EOF: Boolean;
510 base64value: Integer;
511 done: Boolean;
512 c: UCS2;
513 prevc: UCS2;
514 junk: UCS2 { Used In Boolean Context };
515begin
516 Initialize_UTF7_Data;
517 Result := 0;
518 BITbuffer := 0;
519 bufferbits := 0;
520 shifted := False;
521 first := False;
522 wroteone := False;
523 source := sourceStart;
524 target := targetStart;
525 c := 0;
526 if needtables then
527 tabinit;
528 repeat
529 { read an ASCII character c }
530 done := Source >= SourceEnd;
531 if (not done) then
532 begin
533 c := Word(Source^);
534 Inc(Source);
535 end { If };
536 if shifted then
537 begin
538 { We're done with a base64 string if we hit EOF, it's not a valid }
539 { ASCII character, or it's not in the base64 set. }
540 { }
541 base64value := invbase64[c];
542 base64EOF := (done or (c > $7F)) or (base64value < 0);
543 if base64EOF then
544 begin
545 shifted := False;
546 { If the character causing us to drop out was SHIFT_IN or }
547 { SHIFT_OUT, it may be a special escape for SHIFT_IN. The }
548 { test for SHIFT_IN is not necessary, but allows an alternate }
549 { form of UTF-7 where SHIFT_IN is escaped by SHIFT_IN. This }
550 { only works for some values of SHIFT_IN. }
551 { }
552 if ((not done) and ((c = Integer('+')) or (c = Integer('-')))) then
553 begin
554 { get another character c }
555 prevc := c;
556 Done := Source >= SourceEnd;
557 if (not Done) then
558 begin
559 c := Word(Source^);
560 Inc(Source);
561 { If no base64 characters were encountered, and the }
562 { character terminating the shift sequence was }
563 { SHIFT_OUT, then it's a special escape for SHIFT_IN. }
564 { }
565 end;
566 if first and (prevc = Integer('-')) then
567 begin
568 { write SHIFT_IN unicode }
569 if (target >= targetEnd) then
570 begin
571 Result := 2;
572 break;
573 end { If };
574 Target^ := WideChar('+');
575 Inc(Target);
576 end
577 else
578 begin
579 if (not wroteone) then
580 begin
581 Result := 1;
582 end { If };
583 end { Else };
584 ;
585 end { If }
586 else
587 begin
588 if (not wroteone) then
589 begin
590 Result := 1;
591 end { If };
592 end { Else };
593 end { If }
594 else
595 begin
596 { Add another 6 bits of base64 to the bit buffer. }
597 WRITE_N_BITS(base64value, 6, BITbuffer,
598 bufferbits);
599 first := False;
600 end { Else };
601 { Extract as many full 16 bit characters as possible from the }
602 { bit buffer. }
603 { }
604 while (bufferbits >= 16) and (target < targetEnd) do
605 begin
606 { write a unicode }
607 Target^ := WideChar(READ_N_BITS(16, BITbuffer, bufferbits));
608 Inc(Target);
609 wroteone := True;
610 end { While };
611 if (bufferbits >= 16) then
612 begin
613 if (target >= targetEnd) then
614 begin
615 Result := 2;
616 Break;
617 end;
618 end { If };
619 if (base64EOF) then
620 begin
621 junk := READ_N_BITS(bufferbits, BITbuffer, bufferbits);
622 if (junk <> 0) then
623 begin
624 Result := 1;
625 end { If };
626 end { If };
627 end { If };
628 if (not shifted) and (not done) then
629 begin
630 if (c = Integer('+')) then
631 begin
632 shifted := True;
633 first := True;
634 wroteone := False;
635 end { If }
636 else
637 begin
638 { It must be a directly encoded character. }
639 if (c > $7F) then
640 begin
641 Result := 1;
642 end { If };
643 if (target >= targetEnd) then
644 begin
645 Result := 2;
646 break;
647 end { If };
648 Target^ := WideChar(c);
649 Inc(Target);
650 end { Else };
651 end { If };
652 until (done);
653 sourceStart := source;
654 targetStart := target;
655end; { ConvertUTF7toUCS2 }
656
657 {*****************************************************************************}
658 { Thanks to Francisco Leong for providing the Pascal conversion of }
659 { ConvertUTF7.c (by David B. Goldsmith) }
660 {*****************************************************************************}
661
662resourcestring
663 SBufferOverflow = 'Buffer overflow';
664 SInvalidUTF7 = 'Invalid UTF7';
665
666function WideStringToUTF7(const W: WideString): AnsiString;
667var
668 SourceStart, SourceEnd: PWideChar;
669 TargetStart, TargetEnd: PAnsiChar;
670begin
671 if W = '' then
672 Result := ''
673 else
674 begin
675 SetLength(Result, Length(W) * 7); // Assume worst case
676 SourceStart := PWideChar(@W[1]);
677 SourceEnd := PWideChar(@W[Length(W)]) + 1;
678 TargetStart := PAnsiChar(@Result[1]);
679 TargetEnd := PAnsiChar(@Result[Length(Result)]) + 1;
680 if ConvertUCS2toUTF7(SourceStart, SourceEnd, TargetStart,
681 TargetEnd, True, False) <> 0
682 then
683 raise ETntInternalError.Create(SBufferOverflow);
684 SetLength(Result, TargetStart - PAnsiChar(@Result[1]));
685 end;
686end;
687
688function UTF7ToWideString(const S: AnsiString): WideString;
689var
690 SourceStart, SourceEnd: PAnsiChar;
691 TargetStart, TargetEnd: PWideChar;
692begin
693 if (S = '') then
694 Result := ''
695 else
696 begin
697 SetLength(Result, Length(S)); // Assume Worst case
698 SourceStart := PAnsiChar(@S[1]);
699 SourceEnd := PAnsiChar(@S[Length(S)]) + 1;
700 TargetStart := PWideChar(@Result[1]);
701 TargetEnd := PWideChar(@Result[Length(Result)]) + 1;
702 case ConvertUTF7toUCS2(SourceStart, SourceEnd, TargetStart,
703 TargetEnd) of
704 1: raise ETntGeneralError.Create(SInvalidUTF7);
705 2: raise ETntInternalError.Create(SBufferOverflow);
706 end;
707 SetLength(Result, TargetStart - PWideChar(@Result[1]));
708 end;
709end;
710
711function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
712var
713 InputLength,
714 OutputLength: Integer;
715begin
716 if CodePage = CP_UTF7 then
717 Result := UTF7ToWideString(S) // CP_UTF7 not supported on Windows 95
718 else if CodePage = CP_UTF8 then
719 Result := UTF8ToWideString(S) // CP_UTF8 not supported on Windows 95
720 else begin
721 InputLength := Length(S);
722 OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0);
723 SetLength(Result, OutputLength);
724 MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength);
725 end;
726end;
727
728function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
729var
730 InputLength,
731 OutputLength: Integer;
732begin
733 if CodePage = CP_UTF7 then
734 Result := WideStringToUTF7(WS) // CP_UTF7 not supported on Windows 95
735 else if CodePage = CP_UTF8 then
736 Result := WideStringToUTF8(WS) // CP_UTF8 not supported on Windows 95
737 else begin
738 InputLength := Length(WS);
739 OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil);
740 SetLength(Result, OutputLength);
741 WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil);
742 end;
743end;
744
745function UCS2ToWideString(const Value: AnsiString): WideString;
746begin
747 if Length(Value) = 0 then
748 Result := ''
749 else
750 SetString(Result, PWideChar(@Value[1]), Length(Value) div SizeOf(WideChar))
751end;
752
753function WideStringToUCS2(const Value: WideString): AnsiString;
754begin
755 if Length(Value) = 0 then
756 Result := ''
757 else
758 SetString(Result, PAnsiChar(@Value[1]), Length(Value) * SizeOf(WideChar))
759end;
760
761{ Windows.pas doesn't declare TranslateCharsetInfo() correctly. }
762function TranslateCharsetInfo(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo';
763
764function CharSetToCodePage(ciCharset: UINT): Cardinal;
765var
766 C: TCharsetInfo;
767begin
768 Win32Check(TranslateCharsetInfo(PDWORD(ciCharset), C, TCI_SRCCHARSET));
769 Result := C.ciACP
770end;
771
772function LCIDToCodePage(ALcid: LCID): Cardinal;
773var
774 Buf: array[0..6] of AnsiChar;
775begin
776 GetLocaleInfo(ALcid, LOCALE_IDefaultAnsiCodePage, Buf, 6);
777 Result := StrToIntDef(Buf, GetACP);
778end;
779
780function KeyboardCodePage: Cardinal;
781begin
782 Result := LCIDToCodePage(GetKeyboardLayout(0) and $FFFF);
783end;
784
785function KeyUnicode(CharCode: Word): WideChar;
786var
787 AChar: AnsiChar;
788begin
789 // converts the given character (as it comes with a WM_CHAR message) into its
790 // corresponding Unicode character depending on the active keyboard layout
791 if CharCode <= Word(High(AnsiChar)) then begin
792 AChar := AnsiChar(CharCode);
793 MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @AChar, 1, @Result, 1);
794 end else
795 Result := WideChar(CharCode);
796end;
797
798procedure StrSwapByteOrder(Str: PWideChar);
799var
800 P: PWord;
801begin
802 P := PWord(Str);
803 While (P^ <> 0) do begin
804 P^ := MakeWord(HiByte(P^), LoByte(P^));
805 Inc(P);
806 end;
807end;
808
809//--------------------------------------------------------------------
810// LoadResString()
811//
812// This system function is used to retrieve a resourcestring and
813// return the result as an AnsiString. If we believe that the result
814// is only a temporary value, and that it will be immediately
815// assigned to a WideString or a Variant, then we will save the
816// Unicode result as well as a reference to the original Ansi string.
817// WStrFromPCharLen() or VarFromLStr() will return this saved
818// Unicode string if it appears to receive the most recent result
819// of LoadResString.
820//--------------------------------------------------------------------
821
822
823 //===========================================================================================
824 //
825 // function CodeMatchesPatternForUnicode(...);
826 //
827 // GIVEN: SomeWideString := SSomeResString; { WideString := resourcestring }
828 //
829 // Delphi will compile this statement into the following:
830 // -------------------------------------------------
831 // TempAnsiString := LoadResString(@SSomeResString);
832 // LINE 1: lea edx,[SomeTempAnsiString]
833 // LINE 2: mov eax,[@SomeResString]
834 // LINE 3: call LoadResString
835 //
836 // WStrFromLStr(SomeWideString, TempAnsiString); { SomeWideString := TempAnsiString }
837 // LINE 4: mov edx,[SomeTempAnsiString]
838 // LINE 5: mov/lea eax [@SomeWideString]
839 // LINE 6: call @WStrFromLStr
840 // -------------------------------------------------
841 //
842 // The order in which the parameters are prepared for WStrFromLStr (ie LINE 4 & 5) is
843 // reversed when assigning a non-temporary AnsiString to a WideString.
844 //
845 // This code, for example, results in LINE 4 and LINE 5 being swapped.
846 //
847 // SomeAnsiString := SSomeResString;
848 // SomeWideString := SomeAnsiString;
849 //
850 // Since we know the "signature" used by the compiler, we can detect this pattern.
851 // If we believe it is only temporary, we can save the Unicode results for later
852 // retrieval from WStrFromLStr.
853 //
854 // One final note: When assigning a resourcestring to a Variant, the same patterns exist.
855 //===========================================================================================
856
857function CodeMatchesPatternForUnicode(PLine4: PAnsiChar): Boolean;
858const
859 SIZEOF_OPCODE = 1 {byte};
860 MOV_16_OPCODE = AnsiChar($8B); { we'll assume operand size is 16 bits }
861 MOV_32_OPCODE = AnsiChar($B8); { we'll assume operand size is 32 bits }
862 LEA_OPCODE = AnsiChar($8D); { operand size can be 16 or 40 bits }
863 CALL_OPCODE = AnsiChar($E8); { assumed operand size is 32 bits }
864 BREAK_OPCODE = AnsiChar($CC); {in a breakpoint}
865var
866 PLine1: PAnsiChar;
867 PLine2: PAnsiChar;
868 PLine3: PAnsiChar;
869 DataSize: Integer; // bytes in first LEA operand
870begin
871 Result := False;
872
873 PLine3 := PLine4 - SizeOf(CALL_OPCODE) - 4;
874 PLine2 := PLine3 - SizeOf(MOV_32_OPCODE) - 4;
875
876 // figure PLine1 and operand size
877 DataSize := 2; { try 16 bit operand for line 1 }
878 PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
879 if (PLine1^ <> LEA_OPCODE) and (not (IsDebugging and (PLine1^ = BREAK_OPCODE))) then
880 begin
881 DataSize := 5; { try 40 bit operand for line 1 }
882 PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
883 end;
884 if (PLine1^ = LEA_OPCODE) or (IsDebugging and (PLine1^ = BREAK_OPCODE)) then
885 begin
886 if CompareMem(PLine1 + SIZEOF_OPCODE, PLine4 + SIZEOF_OPCODE, DataSize) then
887 begin
888 // After this check, it seems to match the WideString <- (temp) AnsiString pattern
889 Result := True; // It is probably OK. (The side effects of being wrong aren't very bad.)
890 end;
891 end;
892end;
893
894threadvar
895 PLastResString: PAnsiChar;
896 LastResStringValue: AnsiString;
897 LastWideResString: WideString;
898
899procedure FreeTntSystemThreadVars;
900begin
901 LastResStringValue := '';
902 LastWideResString := '';
903end;
904
905procedure Custom_System_EndThread(ExitCode: Integer);
906begin
907 FreeTntSystemThreadVars;
908 {$IFDEF COMPILER_10_UP}
909 if Assigned(SystemThreadEndProc) then
910 SystemThreadEndProc(ExitCode);
911 {$ENDIF}
912 ExitThread(ExitCode);
913end;
914
915function Custom_System_LoadResString(ResStringRec: PResStringRec): AnsiString;
916var
917 ReturnAddr: Pointer;
918begin
919 // get return address
920 asm
921 PUSH ECX
922 MOV ECX, [EBP + 4]
923 MOV ReturnAddr, ECX
924 POP ECX
925 end;
926 // check calling code pattern
927 if CodeMatchesPatternForUnicode(ReturnAddr) then begin
928 // result will probably be assigned to an intermediate AnsiString
929 // on its way to either a WideString or Variant.
930 LastWideResString := WideLoadResString(ResStringRec);
931 Result := LastWideResString;
932 LastResStringValue := Result;
933 if Result = '' then
934 PLastResString := nil
935 else
936 PLastResString := PAnsiChar(Result);
937 end else begin
938 // result will probably be assigned to an actual AnsiString variable.
939 PLastResString := nil;
940 Result := WideLoadResString(ResStringRec);
941 end;
942end;
943
944//--------------------------------------------------------------------
945// WStrFromPCharLen()
946//
947// This system function is used to assign an AnsiString to a WideString.
948// It has been modified to assign Unicode results from LoadResString.
949// Another purpose of this function is to specify the code page.
950//--------------------------------------------------------------------
951
952procedure Custom_System_WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
953var
954 DestLen: Integer;
955 Buffer: array[0..2047] of WideChar;
956 Local_PLastResString: Pointer;
957begin
958 Local_PLastResString := PLastResString;
959 if (Local_PLastResString <> nil)
960 and (Local_PLastResString = Source)
961 and (System.Length(LastResStringValue) = Length)
962 and (LastResStringValue = Source) then begin
963 // use last unicode resource string
964 PLastResString := nil; { clear for further use }
965 Dest := LastWideResString;
966 end else begin
967 if Local_PLastResString <> nil then
968 PLastResString := nil; { clear for further use }
969 if Length <= 0 then
970 begin
971 Dest := '';
972 Exit;
973 end;
974 if Length + 1 < High(Buffer) then
975 begin
976 DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Buffer,
977 High(Buffer));
978 if DestLen > 0 then
979 begin
980 SetLength(Dest, DestLen);
981 Move(Pointer(@Buffer[0])^, Pointer(Dest)^, DestLen * SizeOf(WideChar));
982 Exit;
983 end;
984 end;
985 DestLen := (Length + 1);
986 SetLength(Dest, DestLen); // overallocate, trim later
987 DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest),
988 DestLen);
989 if DestLen < 0 then
990 DestLen := 0;
991 SetLength(Dest, DestLen);
992 end;
993end;
994
995{$IFNDEF COMPILER_9_UP}
996
997//--------------------------------------------------------------------
998// LStrFromPWCharLen()
999//
1000// This system function is used to assign an WideString to an AnsiString.
1001// It has not been modified from its original purpose other than to specify the code page.
1002//--------------------------------------------------------------------
1003
1004procedure Custom_System_LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
1005var
1006 DestLen: Integer;
1007 Buffer: array[0..4095] of AnsiChar;
1008begin
1009 if Length <= 0 then
1010 begin
1011 Dest := '';
1012 Exit;
1013 end;
1014 if Length + 1 < (High(Buffer) div sizeof(WideChar)) then
1015 begin
1016 DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source,
1017 Length, Buffer, High(Buffer),
1018 nil, nil);
1019 if DestLen >= 0 then
1020 begin
1021 SetLength(Dest, DestLen);
1022 Move(Pointer(@Buffer[0])^, PAnsiChar(Dest)^, DestLen);
1023 Exit;
1024 end;
1025 end;
1026
1027 DestLen := (Length + 1) * sizeof(WideChar);
1028 SetLength(Dest, DestLen); // overallocate, trim later
1029 DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest), DestLen,
1030 nil, nil);
1031 if DestLen < 0 then
1032 DestLen := 0;
1033 SetLength(Dest, DestLen);
1034end;
1035
1036//--------------------------------------------------------------------
1037// WStrToString()
1038//
1039// This system function is used to assign an WideString to an short string.
1040// It has not been modified from its original purpose other than to specify the code page.
1041//--------------------------------------------------------------------
1042
1043procedure Custom_System_WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
1044var
1045 SourceLen, DestLen: Integer;
1046 Buffer: array[0..511] of AnsiChar;
1047begin
1048 if MaxLen > 255 then MaxLen := 255;
1049 SourceLen := Length(Source);
1050 if SourceLen >= MaxLen then SourceLen := MaxLen;
1051 if SourceLen = 0 then
1052 DestLen := 0
1053 else begin
1054 DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Pointer(Source), SourceLen,
1055 Buffer, SizeOf(Buffer), nil, nil);
1056 if DestLen > MaxLen then DestLen := MaxLen;
1057 end;
1058 Dest^[0] := Chr(DestLen);
1059 if DestLen > 0 then Move(Buffer, Dest^[1], DestLen);
1060end;
1061
1062{$ENDIF}
1063
1064//--------------------------------------------------------------------
1065// VarFromLStr()
1066//
1067// This system function is used to assign an AnsiString to a Variant.
1068// It has been modified to assign Unicode results from LoadResString.
1069//--------------------------------------------------------------------
1070
1071procedure Custom_System_VarFromLStr(var V: TVarData; const Value: AnsiString);
1072const
1073 varDeepData = $BFE8;
1074var
1075 Local_PLastResString: Pointer;
1076begin
1077 if (V.VType and varDeepData) <> 0 then
1078 VarClear(PVariant(@V)^);
1079
1080 Local_PLastResString := PLastResString;
1081 if (Local_PLastResString <> nil)
1082 and (Local_PLastResString = PAnsiChar(Value))
1083 and (LastResStringValue = Value) then begin
1084 // use last unicode resource string
1085 PLastResString := nil; { clear for further use }
1086 V.VOleStr := nil;
1087 V.VType := varOleStr;
1088 WideString(Pointer(V.VOleStr)) := Copy(LastWideResString, 1, MaxInt);
1089 end else begin
1090 if Local_PLastResString <> nil then
1091 PLastResString := nil; { clear for further use }
1092 V.VString := nil;
1093 V.VType := varString;
1094 AnsiString(V.VString) := Value;
1095 end;
1096end;
1097
1098{$IFNDEF COMPILER_9_UP}
1099
1100//--------------------------------------------------------------------
1101// WStrCat3() A := B + C;
1102//
1103// This system function is used to concatenate two strings into one result.
1104// This function is added because A := '' + '' doesn't necessarily result in A = '';
1105//--------------------------------------------------------------------
1106
1107procedure Custom_System_WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
1108
1109 function NewWideString(CharLength: Longint): Pointer;
1110 var
1111 _NewWideString: function(CharLength: Longint): Pointer;
1112 begin
1113 asm
1114 PUSH ECX
1115 MOV ECX, offset System.@NewWideString;
1116 MOV _NewWideString, ECX
1117 POP ECX
1118 end;
1119 Result := _NewWideString(CharLength);
1120 end;
1121
1122 procedure WStrSet(var S: WideString; P: PWideChar);
1123 var
1124 Temp: Pointer;
1125 begin
1126 Temp := Pointer(InterlockedExchange(Integer(S), Integer(P)));
1127 if Temp <> nil then
1128 WideString(Temp) := '';
1129 end;
1130
1131var
1132 Source1Len, Source2Len: Integer;
1133 NewStr: PWideChar;
1134begin
1135 Source1Len := Length(Source1);
1136 Source2Len := Length(Source2);
1137 if (Source1Len <> 0) or (Source2Len <> 0) then
1138 begin
1139 NewStr := NewWideString(Source1Len + Source2Len);
1140 Move(Pointer(Source1)^, Pointer(NewStr)^, Source1Len * sizeof(WideChar));
1141 Move(Pointer(Source2)^, NewStr[Source1Len], Source2Len * sizeof(WideChar));
1142 WStrSet(Dest, NewStr);
1143 end else
1144 Dest := '';
1145end;
1146
1147{$ENDIF}
1148
1149//--------------------------------------------------------------------
1150// System proc replacements
1151//--------------------------------------------------------------------
1152
1153type
1154 POverwrittenData = ^TOverwrittenData;
1155 TOverwrittenData = record
1156 Location: Pointer;
1157 OldCode: array[0..6] of Byte;
1158 end;
1159
1160procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer; Data: POverwrittenData = nil);
1161{ OverwriteProcedure originally from Igor Siticov }
1162{ Modified by Jacques Garcia Vazquez }
1163var
1164 x: PAnsiChar;
1165 y: integer;
1166 ov2, ov: cardinal;
1167 p: pointer;
1168begin
1169 if Assigned(Data) and (Data.Location <> nil) then
1170 exit; { procedure already overwritten }
1171
1172 // need six bytes in place of 5
1173 x := PAnsiChar(OldProcedure);
1174 if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
1175 RaiseLastOSError;
1176
1177 // if a jump is present then a redirect is found
1178 // $FF25 = jmp dword ptr [xxx]
1179 // This redirect is normally present in bpl files, but not in exe files
1180 p := OldProcedure;
1181
1182 if Word(p^) = $25FF then
1183 begin
1184 Inc(Integer(p), 2); // skip the jump
1185 // get the jump address p^ and dereference it p^^
1186 p := Pointer(Pointer(p^)^);
1187
1188 // release the memory
1189 if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
1190 RaiseLastOSError;
1191
1192 // re protect the correct one
1193 x := PAnsiChar(p);
1194 if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
1195 RaiseLastOSError;
1196 end;
1197
1198 if Assigned(Data) then
1199 begin
1200 Move(x^, Data.OldCode, 6);
1201 { Assign Location last so that Location <> nil only if OldCode is properly initialized. }
1202 Data.Location := x;
1203 end;
1204
1205 x[0] := AnsiChar($E9);
1206 y := integer(NewProcedure) - integer(p) - 5;
1207 x[1] := AnsiChar(y and 255);
1208 x[2] := AnsiChar((y shr 8) and 255);
1209 x[3] := AnsiChar((y shr 16) and 255);
1210 x[4] := AnsiChar((y shr 24) and 255);
1211
1212 if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
1213 RaiseLastOSError;
1214end;
1215
1216procedure RestoreProcedure(OriginalProc: Pointer; Data: TOverwrittenData);
1217var
1218 ov, ov2: Cardinal;
1219begin
1220 if Data.Location <> nil then begin
1221 if not VirtualProtect(Data.Location, 6, PAGE_EXECUTE_READWRITE, @ov) then
1222 RaiseLastOSError;
1223 Move(Data.OldCode, Data.Location^, 6);
1224 if not VirtualProtect(Data.Location, 6, ov, @ov2) then
1225 RaiseLastOSError;
1226 end;
1227end;
1228
1229function Addr_System_EndThread: Pointer;
1230begin
1231 Result := @System.EndThread;
1232end;
1233
1234function Addr_System_LoadResString: Pointer;
1235begin
1236 Result := @System.LoadResString{TNT-ALLOW LoadResString};
1237end;
1238
1239function Addr_System_WStrFromPCharLen: Pointer;
1240asm
1241 mov eax, offset System.@WStrFromPCharLen;
1242end;
1243
1244{$IFNDEF COMPILER_9_UP}
1245function Addr_System_LStrFromPWCharLen: Pointer;
1246asm
1247 mov eax, offset System.@LStrFromPWCharLen;
1248end;
1249
1250function Addr_System_WStrToString: Pointer;
1251asm
1252 mov eax, offset System.@WStrToString;
1253end;
1254{$ENDIF}
1255
1256function Addr_System_VarFromLStr: Pointer;
1257asm
1258 mov eax, offset System.@VarFromLStr;
1259end;
1260
1261function Addr_System_WStrCat3: Pointer;
1262asm
1263 mov eax, offset System.@WStrCat3;
1264end;
1265
1266var
1267 System_EndThread_Code,
1268 System_LoadResString_Code,
1269 System_WStrFromPCharLen_Code,
1270 {$IFNDEF COMPILER_9_UP}
1271 System_LStrFromPWCharLen_Code,
1272 System_WStrToString_Code,
1273 {$ENDIF}
1274 System_VarFromLStr_Code
1275 {$IFNDEF COMPILER_9_UP}
1276 ,
1277 System_WStrCat3_Code,
1278 SysUtils_WideFmtStr_Code
1279 {$ENDIF}
1280 : TOverwrittenData;
1281
1282procedure InstallEndThreadOverride;
1283begin
1284 OverwriteProcedure(Addr_System_EndThread, @Custom_System_EndThread, @System_EndThread_Code);
1285end;
1286
1287procedure InstallStringConversionOverrides;
1288begin
1289 OverwriteProcedure(Addr_System_WStrFromPCharLen, @Custom_System_WStrFromPCharLen, @System_WStrFromPCharLen_Code);
1290 {$IFNDEF COMPILER_9_UP}
1291 OverwriteProcedure(Addr_System_LStrFromPWCharLen, @Custom_System_LStrFromPWCharLen, @System_LStrFromPWCharLen_Code);
1292 OverwriteProcedure(Addr_System_WStrToString, @Custom_System_WStrToString, @System_WStrToString_Code);
1293 {$ENDIF}
1294end;
1295
1296procedure InstallWideResourceStrings;
1297begin
1298 OverwriteProcedure(Addr_System_LoadResString, @Custom_System_LoadResString, @System_LoadResString_Code);
1299 OverwriteProcedure(Addr_System_VarFromLStr, @Custom_System_VarFromLStr, @System_VarFromLStr_Code);
1300end;
1301
1302{$IFNDEF COMPILER_9_UP}
1303procedure InstallWideStringConcatenationFix;
1304begin
1305 OverwriteProcedure(Addr_System_WStrCat3, @Custom_System_WStrCat3, @System_WStrCat3_Code);
1306end;
1307
1308procedure InstallWideFormatFixes;
1309begin
1310 OverwriteProcedure(@SysUtils.WideFmtStr, @TntSysUtils.Tnt_WideFmtStr, @SysUtils_WideFmtStr_Code);
1311end;
1312{$ENDIF}
1313
1314procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
1315begin
1316 InstallEndThreadOverride;
1317 if tsWideResourceStrings in Updates then begin
1318 InstallStringConversionOverrides;
1319 InstallWideResourceStrings;
1320 end;
1321 {$IFNDEF COMPILER_9_UP}
1322 if tsFixImplicitCodePage in Updates then begin
1323 InstallStringConversionOverrides;
1324 { CP_ACP is the code page used by the non-Unicode Windows API. }
1325 GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
1326 end;
1327 if tsFixWideStrConcat in Updates then begin
1328 InstallWideStringConcatenationFix;
1329 end;
1330 if tsFixWideFormat in Updates then begin
1331 InstallWideFormatFixes;
1332 end;
1333 {$ENDIF}
1334end;
1335
1336{$IFNDEF COMPILER_9_UP}
1337var
1338 StartupDefaultUserCodePage: Cardinal;
1339{$ENDIF}
1340
1341procedure UninstallSystemOverrides;
1342begin
1343 RestoreProcedure(Addr_System_EndThread, System_EndThread_Code);
1344 // String Conversion
1345 RestoreProcedure(Addr_System_WStrFromPCharLen, System_WStrFromPCharLen_Code);
1346 {$IFNDEF COMPILER_9_UP}
1347 RestoreProcedure(Addr_System_LStrFromPWCharLen, System_LStrFromPWCharLen_Code);
1348 RestoreProcedure(Addr_System_WStrToString, System_WStrToString_Code);
1349 GDefaultSystemCodePage := StartupDefaultUserCodePage;
1350 {$ENDIF}
1351 // Wide resourcestring
1352 RestoreProcedure(Addr_System_LoadResString, System_LoadResString_Code);
1353 RestoreProcedure(Addr_System_VarFromLStr, System_VarFromLStr_Code);
1354 {$IFNDEF COMPILER_9_UP}
1355 // WideString concat fix
1356 RestoreProcedure(Addr_System_WStrCat3, System_WStrCat3_Code);
1357 // WideFormat fixes
1358 RestoreProcedure(@SysUtils.WideFmtStr, SysUtils_WideFmtStr_Code);
1359 {$ENDIF}
1360end;
1361
1362initialization
1363 {$IFDEF COMPILER_9_UP}
1364 GDefaultSystemCodePage := GetACP;
1365 {$ELSE}
1366 {$IFDEF COMPILER_7_UP}
1367 if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
1368 GDefaultSystemCodePage := CP_THREAD_ACP // Win 2K/XP/...
1369 else
1370 GDefaultSystemCodePage := LCIDToCodePage(GetThreadLocale); // Win NT4/95/98/ME
1371 {$ELSE}
1372 GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
1373 {$ENDIF}
1374 {$ENDIF}
1375 {$IFNDEF COMPILER_9_UP}
1376 StartupDefaultUserCodePage := DefaultSystemCodePage;
1377 {$ENDIF}
1378 IsDebugging := DebugHook > 0;
1379
1380finalization
1381 UninstallSystemOverrides;
1382 FreeTntSystemThreadVars; { Make MemorySleuth happy. }
1383
1384end.
Note: See TracBrowser for help on using the repository browser.