Contributor: FERNAND LEMOINE
UNIT nlcs;
(* DESCRIPTION :
National language and country support
- 18 countries with ISO and DOS convention
- 6 languages English Franais Deutsch Nederland Espaol Italiano
for language name, month name, day name,
yes/no name, true/false name, compare name
- 18 currencies with ISO and DOS convention
- code page
- local and universal time for every country in the world
new type TIMESTAMP
summer time supported
time zone indicated by city name e.g. PARIS,LONDON,NEW-YORK
convention EST,TU
- local country , local currency and local time zone autodetection
RELEASE : 1.0
DATE : 30/09/94
AUTHOR : Fernand LEMOINE
rue du Collge 34
B-6200 CHATELET
BELGIQUE
All code granted to the public domain
Questions and comments are welcome
REQUIREMENT : Turbo Pascal 5.0 or later
Opdate, Opstring, Opabsfld from Object Professional
NOT Compatible with Borland Pascal protected mode !!
*)
INTERFACE
USES opdate, opstring, opabsfld;
TYPE
Str3 = String[3];
LanguageType = (nolang, english, francais, deutch,
nederland, espanol, italiano);
Currency_Iso = RECORD
code : Str3;
mon : Str3;
country : Str3;
tzname : Char;
END;
World_TimeStr = RECORD
abrev : String;
tzone : Char;
offset : Real;
END;
Timestamp =
RECORD
D : Date;
T : Time;
Indic : Char;
MilliTM : LongInt;
Wday : DayType;
YDay : LongInt;
YWeek : Byte;
IsDST : Boolean;
END;
CONST
Currentcountry : String[3] = ' ';
Nb_Of_Currency = 18;
Nb_of_WorldTime = 27;
MaxLanguage = 6;
Table_Currency_iso : ARRAY[1..Nb_Of_Currency] OF Currency_Iso =
((code : '1'; mon : 'USD'; country : 'US'; tzname : 'R'),
(code : '2'; mon : 'CAD'; country : 'CA'; tzname : 'R'),
(code : '31'; mon : 'NLG'; country : 'NL'; tzname : 'A'),
(code : '32'; mon : 'BEF'; country : 'BE'; tzname : 'A'),
(code : '33'; mon : 'FRF'; country : 'FR'; tzname : 'A'),
(code : '34'; mon : 'ESP'; country : 'ES'; tzname : 'A'),
(code : '39'; mon : 'ITL'; country : 'IT'; tzname : 'A'),
(code : '41'; mon : 'CHF'; country : 'CH'; tzname : 'A'),
(code : '44'; mon : 'GBP'; country : 'GB'; tzname : 'Z'),
(code : '45'; mon : 'DKK'; country : 'DK'; tzname : 'A'),
(code : '46'; mon : 'SEK'; country : 'SE'; tzname : 'A'),
(code : '47'; mon : 'NOK'; country : 'NO'; tzname : 'A'),
(code : '49'; mon : 'DEM'; country : 'DE'; tzname : 'A'),
(code : '61'; mon : 'AUD'; country : 'AU'; tzname : 'K'),
(code : '81'; mon : 'JPY'; country : 'JP'; tzname : 'I'),
(code : '351'; mon : 'PTE'; country : 'PT'; tzname : 'Z'),
(code : '358'; mon : 'FIM'; country : 'FI'; tzname : 'B'),
(code : '972'; mon : 'ILS'; country : 'IL'; tzname : 'B')
);
Table_WorldTime : ARRAY[1..Nb_of_WorldTime] OF World_TimeStr =
((abrev : 'Z/LONDON/UT/GMT'; tzone : 'Z'; offset : 0),
(abrev : 'A/PARIS/CET'; tzone : 'A'; offset : + 1),
(abrev : 'B/CAIRO'; tzone : 'B'; offset : + 2),
(abrev : 'C/MOSCOW/BAGDAD'; tzone : 'C'; offset : + 3),
(abrev : 'D/DUBAI'; tzone : 'D'; offset : + 4),
(abrev : 'E/KARACHI'; tzone : 'E'; offset : + 5),
(abrev : 'F/DACCA'; tzone : 'F'; offset : + 6),
(abrev : 'G/BANGKOK'; tzone : 'G'; offset : + 7),
(abrev : 'H/HONG KONG/PERTH'; tzone : 'H'; offset : + 8),
(abrev : 'I/TOKYO'; tzone : 'I'; offset : + 9),
(abrev : 'K/SYDNEY'; tzone : 'K'; offset : + 10),
(abrev : 'L/NOUMEA'; tzone : 'L'; offset : + 11),
(abrev : 'M/WELLINGTON'; tzone : 'M'; offset : + 12),
(abrev : 'N/AZORCS'; tzone : 'N'; offset : - 1),
(abrev : 'O/FERNANDO'; tzone : 'O'; offset : - 2),
(abrev : 'P/RIO'; tzone : 'P'; offset : - 3),
(abrev : 'Q/CARACAS/IST'; tzone : 'Q'; offset : - 4),
(abrev : 'R/NEW YORK/EST'; tzone : 'R'; offset : - 5),
(abrev : 'S/CHICAGO/CST'; tzone : 'S'; offset : - 6),
(abrev : 'T/DENVER/MST'; tzone : 'T'; offset : - 7),
(abrev : 'U/LOS ANGELES/PST'; tzone : 'U'; offset : - 8),
(abrev : 'V/ANCHORAGE/AST'; tzone : 'V'; offset : - 9),
(abrev : 'W/HONOLULU'; tzone : 'W'; offset : - 10),
(abrev : 'X/MIDWAY'; tzone : 'X'; offset : - 11),
(abrev : 'TERRE NEUVE/NST'; tzone : 'Y'; offset : - 3.30),
(abrev : 'TEHERAN'; tzone : 'Y'; offset : + 3.30),
(abrev : 'NEW DELHI'; tzone : 'Y'; offset : + 5.30));
LanguageNames : ARRAY[LanguageType] OF String[10] =
('NoLanguage', 'English', 'Franais', 'Deutsch', 'Nederland',
'Espaol', 'Italiano');
InternationalMonthString : ARRAY[1..MaxLanguage]
OF ARRAY[1..12] OF String[10] =
(('January', 'February', 'March', 'April', 'May', 'June', 'July',
'August', 'September', 'October', 'November', 'December'),
('janvier', 'fvrier', 'mars', 'avril', 'mai', 'juin', 'juillet',
'aot', 'septembre', 'octobre', 'novembre', 'dcembre'),
('Januar', 'Februar', 'Marz', 'April', 'Mai', 'Juni', 'Juli',
'August', 'September', 'Oktober', 'November', 'Dezember'),
('Januari', 'Februari', 'Maart', 'April', 'Mei', 'Juni', 'Juli',
'Augustus', 'September', 'October', 'November', 'December'),
('Enero', 'Febrero', 'Marzo', 'Abril', 'Mayo', 'Junio', 'Julio',
'Agosto', 'Septiembre', 'Octubre', 'Noviembre', 'Diciembre'),
('Gennaio', 'Febbraio', 'Marzo', 'Aprile', 'Maggio', 'Giugno', 'Luglio',
'Agusto', 'Settembre', 'Ottobre', 'Novembre', 'Dicembre'));
InternationalDayString : ARRAY[1..MaxLanguage, DayType] OF String[10] =
(('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'),
('dimanche', 'lundi', 'mardi', 'mercredi', 'jeudi', 'vendredi', 'samedi'),
('Sonntag', 'Montag', 'Dienstag', 'Mittwoch', 'Donnerstag', 'Freitag', 'Samstag'),
('Zondag', 'Maandag', 'Dinsdag', 'Woensdag', 'Donderdag', 'Vrijdag', 'Zaterdag'),
('Dominguo', 'Lunes', 'Martes', 'Miercoles', 'Jueves', 'Viernes', 'Sabado'),
('Domenica', 'Lunedi', 'Martedi', 'Mercoledi', 'Giovedi', 'Venerdi', 'Sabato'));
InternationalTrueFalse : ARRAY[1..MaxLanguage, 1..2] OF Char =
(('Y', 'N'), ('O', 'N'), ('J', 'N'), ('J', 'N'), ('S', 'N'), ('S', 'N'));
InternationalYesNo : ARRAY[1..MaxLanguage, 1..2] OF Char =
(('T', 'F'), ('V', 'F'), ('W', 'F'), ('W', 'V'), ('V', 'F'), ('V', 'F'));
InternationalCompareString : ARRAY[1..MaxLanguage, 1..3] OF String[8] =
(('Less', 'Equal', 'Greater'),
('Moins', 'gal', 'Plus'),
('Minder', 'Gleich', 'Mehr'),
('Minder', 'Gelijk', 'Meer'),
('Menos ', 'Igual ', 'Ms'),
('Meno ', 'Eguale', 'Pi'));
VAR
Language : LanguageType;
FUNCTION GetCodePage : Word;
PROCEDURE SetCodePage(valeur : Word);
(* Return number *)
FUNCTION GetCountry : Word;
(* Return ISO convention *)
FUNCTION GetCountryStr : Str3;
(* value can be ISO convention e.g. BE
or number in alphabetic form e.g. '32' *)
PROCEDURE SetCountry(value : Str3);
PROCEDURE SetLanguage(Val : LanguageType);
FUNCTION GetLanguage : String;
(* Give correct alphabetic order with current code page *)
FUNCTION CompIntString(S1, S2 : String) : CompareType;
(* Value can be ISO convention e.g. BE
or number in alphabetic form e.g. '32' *)
FUNCTION ConvertToCountry(value : Str3) : Word;
(* Return ISO convention for currency *)
PROCEDURE CurrencyIso(value : Str3);
FUNCTION DayOfYear(Julian : Date) : Word;
(* Week 1 is the first week that contains a Thursay *)
FUNCTION WeekOfYear(Julian : Date) : Byte;
PROCEDURE CurrentDateTime(VAR TS : Timestamp);
(* tzname can be a city name or an abbreviation
daylight must be modified for summer time *)
PROCEDURE SetLocalTime(tzname : String; daylight : Byte;
VAR TS : Timestamp);
PROCEDURE SetUniversalTime(VAR TS : Timestamp);
(* To bypass autodetection *)
PROCEDURE SetTimeZone(tzname : String; daylight : Byte; VAR tz : Char);
IMPLEMENTATION
USES dos, opdos;
CONST
Delims : SET OF Char = [',', '/'];
TYPE
PCollating = ^TCollating;
TCollating = RECORD
len : Word;
table : ARRAY[0..255] OF Char;
END;
VAR
TimeZone : LongInt;
CollatingSequence : PCollating;
TimeZoneName : Char;
FUNCTION GetCodePage : Word;
VAR
reg : registers;
BEGIN
WITH reg DO
BEGIN
AH := $66;
AL := $01;
MsDos(reg);
GetCodePage := BX;
END;
END;
PROCEDURE SetCodePage(valeur : Word);
VAR
reg : registers;
BEGIN
WITH reg DO
BEGIN
AH := $66;
AL := $02;
BX := valeur;
MsDos(reg);
END;
END;
(*-----------------------------------------------------------------*)
PROCEDURE InternationalCollating(VAR CollatingSeq : PCollating);
TYPE
Tinfo = RECORD
id : Byte;
P : Pointer;
END;
VAR
regs : registers;
info : Tinfo;
i : Integer;
BEGIN
WITH regs DO
BEGIN
AH := $65;
AL := $06;
BX := GetCodePage;
CX := $5;
DX := 1;
ES := Seg(info);
DI := Ofs(info);
MsDos(regs);
END;
CollatingSeq := info.P;
END;
(*-----------------------------------------------------------------*)
FUNCTION CompIntString(S1, S2 : String) : CompareType;
VAR
i : Byte;
BEGIN
FOR i := 0 TO Length(S1) DO
BEGIN
S1[i] := (CollatingSequence^.table[Ord(S1[i])]);
END;
FOR i := 0 TO Length(S2) DO
BEGIN
S2[i] := CollatingSequence^.table[Ord(S2[i])];
END;
CompIntString := CompString(S1, S2);
END;
(*-----------------------------------------------------------------*)
FUNCTION DayOfYear(Julian : Date) : Word;
VAR
Day, Month, Year : Integer;
Days : Word;
FirstDay : Date;
Secs : LongInt;
DT1, DT2 : DateTimeRec;
BEGIN
DateToDMY(Julian, Day, Month, Year);
FirstDay := DMYToDate(01, 01, Year);
DT1.D := Julian;
DT1.T := CurrentTime;
DT2.D := FirstDay;
DT2.T := CurrentTime;
DateTimeDiff(DT1, DT2, Days, Secs);
DayOfYear := Days + 1;
END;
FUNCTION WeekOfYear(Julian : Date) : Byte;
VAR
Day, Month, Year : Integer;
FirstDay : Date;
Tmp, tmp2 : Byte;
BEGIN
DateToDMY(Julian, Day, Month, Year);
FirstDay := DMYToDate(01, 01, Year);
CASE DayOfWeek(FirstDay) OF
Sunday : Tmp := 5;
Monday : Tmp := 6;
Tuesday : Tmp := 7;
Wednesday : Tmp := 8;
Thursday : Tmp := 9;
Friday : Tmp := 3;
Saturday : Tmp := 4;
END;
tmp2 := (DayOfYear(Julian) + Tmp) DIV 7;
IF (tmp2 = 0) AND ((Tmp = 3) OR (Tmp = 4) OR (Tmp = 5)) THEN
BEGIN
FirstDay := DMYToDate(01, 01, (Year - 1));
CASE DayOfWeek(FirstDay) OF
Sunday : Tmp := 5;
Monday : Tmp := 6;
Tuesday : Tmp := 7;
Wednesday : Tmp := 8;
Thursday : Tmp := 9;
Friday : Tmp := 3;
Saturday : Tmp := 4;
END;
tmp2 := (DayOfYear(DMYToDate(31, 12, Year - 1)) + Tmp) DIV 7;
END;
WeekOfYear := tmp2;
END;
(* ---------------------------------------------------------------*)
PROCEDURE SetInternationalMonthDay(Val : LanguageType);
VAR
value, i : Byte;
j : DayType;
BEGIN
value := Ord(Val);
FOR i := 1 TO 12 DO
MonthString[i] := InternationalMonthString[value, i];
FOR j := Sunday TO Saturday DO
DayString[j] := InternationalDayString[value, j];
END;
(*---------------------------------------------------------------------*)
PROCEDURE SetDateTime(VAR TS : Timestamp);
BEGIN
TS.Wday := DayOfWeek(TS.D);
TS.YDay := DayOfYear(TS.D);
TS.YWeek := WeekOfYear(TS.D);
END;
FUNCTION Match(S, P : String) : Boolean;
VAR
Ind, j, N, Nprime : Byte;
Prov : Boolean;
BEGIN
Prov := False; j := 1;
Ind := WordCount(P, Delims);
WHILE (j <= Ind) AND NOT Prov DO
BEGIN
N := WordPosition(j, P, Delims);
IF j < Ind THEN
BEGIN
Nprime := WordPosition(j + 1, P, Delims);
Prov := S = Copy(P, N, Nprime - N - 1);
END
ELSE
Prov := S = Copy(P, N, (Length(P) - N + 1));
Inc(j);
END;
Match := Prov;
END;
(*---------------------------------------------------------------------*)
PROCEDURE CurrentDateTime(VAR TS : Timestamp);
BEGIN
TS.MilliTM := TimeMS;
TS.IsDST := False;
TS.T := CurrentTime;
TS.D := Today;
SetDateTime(TS);
TS.Indic := TimeZoneName;
END;
(*---------------------------------------------------------------------*)
PROCEDURE SetLocalTime(tzname : String; daylight : Byte;
VAR TS : Timestamp);
VAR i : Byte;
off : Real;
DT : DateTimeRec;
found : Boolean;
BEGIN
SetDateTime(TS);
TS.IsDST := daylight <> 0;
IF NOT(TS.Indic = 'Z') THEN
SetUniversalTime(TS);
SetTimeZone(tzname, daylight, TS.Indic);
DT.D := TS.D; DT.T := TS.T;
IncDateTime(DT, DT, 0, TimeZone);
TS.D := DT.D; TS.T := DT.T;
END;
(*---------------------------------------------------------------------*)
PROCEDURE SetUniversalTime(VAR TS : Timestamp);
VAR
DT : DateTimeRec;
BEGIN
SetDateTime(TS);
DT.D := TS.D; DT.T := TS.T;
IncDateTime(DT, DT, 0, (TimeZone * - 1));
TS.D := DT.D; TS.T := DT.T;
TS.IsDST := False;
TS.Indic := 'Z';
END;
(*---------------------------------------------------------------------*)
PROCEDURE SetTimeZone(tzname : String; daylight : Byte; VAR tz : Char);
VAR i : Byte;
off : Real;
found : Boolean;
BEGIN
found := False; i := 1;
WHILE (i <= Nb_of_WorldTime) AND (NOT found) DO
BEGIN
IF Match(StUpCase(tzname), Table_WorldTime[i].abrev) THEN
BEGIN
off := Table_WorldTime[i].offset;
tz := Table_WorldTime[i].tzone;
found := True;
END;
Inc(i);
END;
off := off + daylight;
TimeZone := Trunc(Int(off) * SecondsInHour
+ (Frac(off) * 100 * SecondsInMinute));
END;
(*-----------------------------------------------------------------*)
PROCEDURE CurrencyTimeZone(value : Str3);
VAR i : Byte;
BEGIN
FOR i := 1 TO Nb_Of_Currency DO
IF (Table_Currency_iso[i].code = value)
OR (Table_Currency_iso[i].country = value)
THEN
BEGIN
CurrencyLtStr := Table_Currency_iso[i].mon;
CurrencyRtStr := Table_Currency_iso[i].mon;
SetTimeZone(Table_Currency_iso[i].tzname, 0, TimeZoneName);
END;
END;
(*-----------------------------------------------------------------*)
PROCEDURE SetCountry(value : Str3);
VAR
regs : registers;
i : Byte;
valeur : Word;
BEGIN
FOR i := 1 TO Nb_Of_Currency DO
IF (Table_Currency_iso[i].code = value)
OR (Table_Currency_iso[i].country = value)
THEN
IF Str2word(Table_Currency_iso[i].code, valeur) THEN
BEGIN
WITH regs DO BEGIN
{get pointer to country information table}
AX := $3800;
DX := $0FFFF;
IF valeur < 255 THEN
AL := valeur
ELSE
BEGIN
AL := $FF;
BX := valeur;
END;
Intr($21, regs);
END;
(* CurrencyTimeZone(GetCountryStr);*)
InternationalCollating(CollatingSequence);
END;
END;
(*-----------------------------------------------------------------*)
FUNCTION GetCountry : Word;
VAR
info : CountryInfo;
regs : registers;
BEGIN
WITH regs DO BEGIN
AX := $3800;
DS := Seg(info);
DX := Ofs(info);
AL := $0;
Intr($21, regs);
GetCountry := BX;
END;
END;
(*-----------------------------------------------------------------*)
FUNCTION GetCountryStr : Str3;
VAR
i : Byte;
value : Str3;
BEGIN
value := Long2Str(GetCountry);
FOR i := 1 TO Nb_Of_Currency DO
IF (Table_Currency_iso[i].code = value)
OR (Table_Currency_iso[i].country = value)
THEN
GetCountryStr := Table_Currency_iso[i].country;
END;
PROCEDURE CurrencyIso(value : Str3);
VAR i : Byte;
BEGIN
FOR i := 1 TO Nb_Of_Currency DO
IF (Table_Currency_iso[i].code = value)
OR (Table_Currency_iso[i].country = value)
THEN
BEGIN
CurrencyLtStr := Table_Currency_iso[i].mon;
CurrencyRtStr := Table_Currency_iso[i].mon;
END;
END;
(* --------------------------------------------------------------*)
FUNCTION ConvertToCountry(value : Str3) : Word;
VAR i : Byte;
wrk : Word;
error : Integer;
BEGIN
wrk := 1;
FOR i := 1 TO Nb_Of_Currency DO
IF Table_Currency_iso[i].country = StUpCase(value)
THEN
Val(Table_Currency_iso[i].code, wrk, error);
ConvertToCountry := wrk;
END;
(*-----------------------------------------------------------------*)
PROCEDURE SetInternationalTrueYes(Val : LanguageType);
VAR
value : Byte;
BEGIN
value := Ord(Val);
TrueChar := InternationalTrueFalse[value, 1];
FalseChar := InternationalTrueFalse[value, 2];
YesChar := InternationalYesNo[value, 1];
NoChar := InternationalYesNo[value, 2];
BooleanSet := [InternationalTrueFalse[value, 1],
LoCase(InternationalTrueFalse[value, 1]),
InternationalTrueFalse[value, 1],
LoCase(InternationalTrueFalse[value, 1])];
YesNoSet := [InternationalTrueFalse[value, 2],
LoCase(InternationalTrueFalse[value, 2]),
InternationalTrueFalse[value, 2],
LoCase(InternationalTrueFalse[value, 2])];
END;
(* --------------------------------------------------------------- *)
PROCEDURE SetLanguage(Val : LanguageType);
VAR
i : Word;
BEGIN
Language := Val;
CASE Language OF
english, nederland, italiano : SetCodePage(437);
francais, deutch, espanol :
BEGIN
SetCodePage(850);
SetInternationalUpcase;
END;
END;
SetInternationalMonthDay(Val);
SetInternationalTrueYes(Val);
New(CollatingSequence);
InternationalCollating(CollatingSequence);
END;
(* --------------------------------------------------------------- *)
FUNCTION GetLanguage : String;
BEGIN
GetLanguage := LanguageNames[LanguageType(Language)];
END;
BEGIN
Currentcountry := GetCountryStr;
CurrencyTimeZone(GetCountryStr);
END.
{ ---------------- DEMO PROGRAM ------------------- }
program demonlcs;
(* Demonstration program for use of nlcs unit *)
uses crt,opdate,nlcs,opabsfld,opstring,
editform;
var
TS,r : timestamp;
S1,S2 : string;
found: boolean;
i : word;
begin
clrscr;
writeln ('DEMO NLCS');writeln;
S1 := 'zone'; S2 := 't';
SetLanguage(francais);
writeln(STUpcase(S1),' ',StUpcase(S2));
writeln (' Comparaison correcte avec CompIntString ');
case CompIntString(S1,S2) of
less : writeln ('S1 < S2');
equal : writeln ('S1 = S2');
greater : writeln ('S1 > S2');
end;
writeln( 'Comparaison incorrecte avec CompString');
case CompString(S1,S2) of
less : writeln ('S1 < S2');
equal : writeln ('S1 = S2');
greater : writeln ('S1 > S2');
end;
CurrentDateTime(TS);
writeln('Heure locale : ',TimeStampForm('DTWZS',TS));
SetUniversalTime(TS);
writeln('Heure universelle : ',TimeStampForm('DTWZS',TS));
SetLocalTime('EST',0,TS);
writeln('Heure Los Angeles : ',TimeStampForm('DTWZS',TS));
delay(3500);
CurrentDateTime(r);
Writeln('Temps coul en ms: ',
RealForm('##.#',(R.MilliTm - TS.MilliTM)/1000.0));
writeln;
writeln('Langage : ', GetLanguage);
writeln('Code Page : ', GetCodePage);
writeln('Pays local : ', GetCountryStr);
writeln('Symbole montaire: ', CurrencyLtStr);
delay(5500);
end.