Update from gertjan Schouten, plus small fix for linux

rtl/objpas/dati.inc

@@ -21,68 +21,126 @@
     System Utilities For Free Pascal
 }
 
-{ date time functions }
+{==============================================================================}
+{   internal functions                                                         }
+{==============================================================================}
 
-function IsLeapYear(Year: Word): Boolean;
+const
+   DayTable: array[Boolean, 1..12] of longint =
+      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
+       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+{$IFDEF GO32V2}
+var Regs: Registers;
 begin
-IsLeapYear := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
-end;
+Regs.ah := $2C;
+RealIntr($21, Regs);
+SystemTime.Hour := Regs.Ch;
+SystemTime.Minute := Regs.Cl;
+SystemTime.Second := Regs.Dh;
+SystemTime.MilliSecond := Regs.Dl;
+Regs.ah := $2A;
+RealIntr($21, Regs);
+SystemTime.Year := Regs.Cx;
+SystemTime.Month := Regs.Dh;
+SystemTime.Day := Regs.Dl;
+end ;
+{$ELSE}
+{$IFDEF LINUX}
+begin
+linux.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second);
+linux.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
+SystemTime.MilliSecond := 0;
+end ;
+{$ELSE}
+begin
+end ;
+{$ENDIF}
+{$ENDIF}
 
-function DoEncodeDate(Year, Month, Day: Word):longint;
-var
-   I: Longint;
+function DoEncodeDate(Year, Month, Day: Word): longint;
+var i: longint;
 begin
-  DoEncodeDate := 0;
-  if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
-     (Day >= 1) and (Day <= 31) then
-    begin
-      Day := Day + DayTable[IsLeapYear(Year), Month] - 1;
-      I := Year - 1;
-      DoEncodeDate := I * 365 + I div 4 - I div 100 + I div 400 + Day;
-    end;
-end;
+Result := 0;
+if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
+   (Day >= 1) and (Day <= 31) then begin
+   Day := Day + DayTable[IsLeapYear(Year), Month] - 1;
+   I := Year - 1;
+   result := I * 365 + I div 4 - I div 100 + I div 400 + Day - DateDelta;
+   end ;
+end ;
+
+function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): longint;
+begin
+result := (Hour * 3600000 + Minute * 60000 + Second * 1000 + MilliSecond) { div MSecsPerDay} ;
+end ;
+
+{==============================================================================}
+{   Public functions                                                           }
+{==============================================================================}
 
-function  doEncodeTime(Hour,Minute,Second,MilliSecond:word):longint;
+{   DateTimeToTimeStamp converts DateTime to a TTimeStamp   }
+
+function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
 begin
-  doEncodeTime := (Hour * 3600000 + Minute * 60000 + Second * 1000 + MilliSecond) { div MSecsPerDay} ;
-end;
+result.Time := Trunc(Frac(DateTime) * MSecsPerDay);
+result.Date := 1 + DateDelta + Trunc(Int(DateTime));
+end ;
 
-function  DateToStr(Date:TDateTime):string;
+{   TimeStampToDateTime converts TimeStamp to a TDateTime value   }
+
+function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
 begin
-  DateToStr := FormatDateTime('c', Date);
-end;
+result := (TimeStamp.Date - DateDelta - 1) + (TimeStamp.Time / MSecsPerDay);
+end ;
+
+{   MSecsToTimeStamp   }
 
-function  TimeToStr(Time:TDateTime):string;
+function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
 begin
-  TimeToStr := FormatDateTime('t', Time);
-end;
+result.Time := Trunc(MSecs);
+result.Date := 0;
+end ;
+
+{   TimeStampToMSecs   }
 
-function  DateTimeToStr(DateTime:TDateTime):string;
+function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
 begin
-  DateTimeToStr := FormatDateTime('c t', DateTime);
-end;
+result := TimeStamp.Time;
+end ;
+
+{   EncodeDate packs three variables Year, Month and Day into a
+    TDateTime value the result is the number of days since 12/30/1899   }
 
-function  EncodeDate(Year, Month, Day :word):TDateTime;
+function EncodeDate(Year, Month, Day: word): TDateTime;
 begin
-  EncodeDate := DoEncodeDate(Year, Month, Day);
-end;
+result := DoEncodeDate(Year, Month, Day);
+end ;
+
+{   EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
+    a TDateTime value     }
 
-function  EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
+function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
 begin
-  EncodeTime := doEncodeTime(hour, minute, second, millisecond) / double(MSecsPerDay);
-end;
+Result := DoEncodeTime(hour, minute, second, millisecond) / MSecsPerDay;
+end ;
 
-procedure DecodeDate(Date:TDateTime;var Year:word;var Month:word;var Day:word);
+{   DecodeDate unpacks the value Date into three values:
+    Year, Month and Day   }
+
+procedure DecodeDate(Date: TDateTime; var Year, Month, Day: word);
 const
    D1 = 365;            { number of days in 1 year }
    D4 = D1 * 4 + 1;     { number of days in 4 years }
    D100 = D4 * 25 - 1;  { number of days in 100 years }
    D400 = D100 * 4 + 1; { number of days in 400 years }
 var
+   i:Longint;
    l:longint;
    ly:boolean;
 begin
-l := Trunc(Int(Date));
+l := Trunc(Int(Date)) + DateDelta;
 year := 1 + 400 * (l div D400); l := (l mod D400);
 year := year + 100 * (l div D100);l := (l mod D100);
 year := year + 4 * (l div D4);l := (l mod D4);
@@ -92,9 +150,12 @@ ly := IsLeapYear(Year);
 while (month < 12) and (l > DayTable[ly, month + 1]) do
    inc(month);
 day := l - DayTable[ly, month];
-end;
+end ;
 
-procedure DecodeTime(Time:TDateTime;var Hour:word;var Minute:word;var Second:word;var MilliSecond:word);
+{   DecodeTime unpacks Time into four values:
+    Hour, Minute, Second and MilliSecond    }
+
+procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
 var l:longint;
 begin
 l := Trunc(Frac(time) * MSecsPerDay);
@@ -102,96 +163,127 @@ Hour   := l div 3600000;l := l mod 3600000;
 Minute := l div 60000;l := l mod 60000;
 Second := l div 1000;l := l mod 1000;
 MilliSecond := l;
-end;
+end ;
 
-function  FormatDateTime(formatstr:string;DateTime:TDateTime):string;
-var i:longint;result:string;current:string;e:longint;
-    y,m,d,h,n,s,ms:word;
-    mDate, mTime:double;
+{   DateTimeToSystemTime converts DateTime value to SystemTime   }
+
+procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime);
 begin
-mDate := int(DateTime);
-mTime := frac(DateTime);
-DecodeDate(mDate, y, m, d);
-DecodeTime(mTime, h, n, s, ms);
-result := '';
-current := '';
-i := 1;
-e := 0;
-while not(i > length(formatstr)) do begin
-   while not(formatstr[i] in [' ','"','/',':','''']) and not(i > length(formatstr)) do begin
-      current := current + formatstr[i];
-      inc(i);
-      end;
-   if ((current = 'a') or (current = 'am')) and (formatstr[i] = '/') then begin
-      inc(i);current := current + '/';
-      while not(formatstr[i] in [' ','"','/',':','''']) and not(i > length(formatstr)) do begin
-         current := current + formatstr[i];
-         inc(i);
-         end;
-      end;
-   if not(current = '') then begin
-      if (current = 'c') then begin
-         i := 1; result := ''; current := '';
-         formatstr := ' ' + shortdateformat + '" "' + shorttimeformat;
-         end;
-      if not(mTime = 0) then begin
-         if (current = 't') then begin
-            formatstr := ' ' + shorttimeformat + copy(formatstr, i, length(formatstr));
-            i := 1;
-            end
-         else if (current = 'tt') then begin
-            formatstr := ' ' + longtimeformat + copy(formatstr,i,length(formatstr));
-            i := 1;
-            end
-         else if (current = 'h') then result := result + inttostr(h)
-         else if (current = 'hh') then result := result + right('0'+inttostr(h),2)
-         else if (current = 'n') then result := result + inttostr(n)
-         else if (current = 'nn') then result := result + right('0'+inttostr(n),2)
-         else if (current = 's') then result := result + inttostr(s)
-         else if (current = 'ss') then result := result + right('0'+inttostr(s),2)
-         else if (current = 'am/pm') then begin
-           if (h < 13) then result := result + 'am'
-            else result := result + 'pm';
-                           end
-         else if (current = 'a/p') then begin
-           if h < 13 then result := result + 'a'
-            else result := result + 'p';
-           end
-         else if (current = 'ampm') then begin
-            if h < 13 then strCat(result, TimeAMString)
-            else strCat(result, TimePMString);
-            end;
-         end;
-      if not(mDate = 0) then begin
-         if (current = 'd') then result := result + inttostr(d)
-         else if (current = 'dd') then result := result + right('0' + inttostr(d), 2)
-         else if (current = 'ddd') then StrCat(result, shortdaynames[DayOfWeek(DateTime)])
-         else if (current = 'dddd') then StrCat(result, longdaynames[DayOfWeek(DateTime)])
-         else if (current = 'm') then result := result + inttostr(m)
-         else if (current = 'mm') then result := result + right('0' + inttostr(m), 2)
-         else if (current = 'mmm') then StrCat(result, shortmonthnames[m])
-         else if (current = 'mmmm') then StrCat(result, longmonthnames[m])
-         else if (current = 'y') then result := result + inttostr(y)
-         else if (current = 'yy') then result := result + right(inttostr(y), 2)
-         else if (current = 'yyyy') or (current = 'yyy') then result := result + inttostr(y);
-         end;
-      current := '';
-      end;
-   if (formatstr[i] = '/') and not(mDate = 0) then result := result + dateseparator
-   else if (formatstr[i] = ':') and not(mTime = 0) then result := result + timeseparator
-   else if (formatstr[i] in ['"','''']) then begin
-      inc(i);
-      while not(formatstr[i] in ['"','''']) and not(i > length(formatstr)) do begin
-         result := result + formatstr[i];
-         inc(i);
-         end;
-      end;
-   inc(i);
-   end;
-FormatDateTime := Result;
+DecodeDate(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day);
+DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
+end ;
+
+{   SystemTimeToDateTime converts SystemTime to a TDateTime value   }
+
+function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
+begin
+result := DoEncodeDate(SystemTime.Year,
+                       SystemTime.Month,
+                       SystemTime.Day) +
+          DoEncodeTime(SystemTime.Hour,
+                       SystemTime.Minute,
+                       SystemTime.Second,
+                       SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{   DayOfWeek returns the Day of the week (sunday is day 1)  }
+
+function DayOfWeek(DateTime: TDateTime): integer;
+begin
+Result := 1 + (Trunc(DateTime) mod 7);
+end ;
+
+{   Date returns the current Date   }
+
+function Date: TDateTime;
+var SystemTime: TSystemTime;
+begin
+GetLocalTime(SystemTime);
+result := DoEncodeDate(SystemTime.Year,
+                       SystemTime.Month,
+                       SystemTime.Day);
+end ;
+
+{   Time returns the current Time   }
+
+function Time: TDateTime;
+var SystemTime: TSystemTime;
+begin
+GetLocalTime(SystemTime);
+Result := DoEncodeTime(SystemTime.Hour,
+                       SystemTime.Minute,
+                       SystemTime.Second,
+                       SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{   Now returns the current Date and Time    }
+
+function Now: TDateTime;
+var SystemTime: TSystemTime;
+begin
+GetLocalTime(SystemTime);
+result := DoEncodeDate(SystemTime.Year,
+                       SystemTime.Month,
+                       SystemTime.Day) +
+          DoEncodeTime(SystemTime.Hour,
+                       SystemTime.Minute,
+                       SystemTime.Second,
+                       SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{   IncMonth increments DateTime with NumberOfMonths months,
+    NumberOfMonths can be less than zero   }
+
+function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer): TDateTime;
+var Year, Month, Day: word;
+begin
+DecodeDate(DateTime, Year, Month, Day);
+Month := Month - 1 + NumberOfMonths;      {   Months from 0 to 11   }
+Year := Year + (NumberOfMonths div 12);
+Month := Month mod 12;
+if Month < 0 then begin
+   Inc(Month, 12);
+   Inc(Year, 1);
+   end ;
+Inc(Month, 1);                            {   Months from 1 to 12   }
+if (Month = 2) and (IsLeapYear(Year)) and (Day > 28) then
+   Day := 28;
+result := Frac(DateTime) + DoEncodeDate(Year, Month, Day);
+end ;
+
+{  IsLeapYear returns true if Year is a leap year   }
+
+function IsLeapYear(Year: Word): boolean;
+begin
+Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
 end;
 
-function  StrToDate(const s:string):TDateTime;
+{  DateToStr returns a string representation of Date using ShortDateFormat   }
+
+function DateToStr(Date: TDateTime): string;
+begin
+result := FormatDateTime('ddddd', Date);
+end ;
+
+{  TimeToStr returns a string representation of Time using ShortTimeFormat   }
+
+function TimeToStr(Time: TDateTime): string;
+begin
+result := FormatDateTime('t', Time);
+end ;
+
+{   DateTimeToStr returns a string representation of DateTime using ShortDateTimeFormat   }
+
+function DateTimeToStr(DateTime: TDateTime): string;
+begin
+result := FormatDateTime('c', DateTime);
+end ;
+
+{   StrToDate converts the string S to a TDateTime value
+    if S does not represent a valid date value
+    an EConvertError will be raised   }
+
+function StrToDate(const S: string): TDateTime;
 var
    df:string;
    d,m,y:word;n,i:longint;c:word;
@@ -210,8 +302,8 @@ for i := 1 to length(s) do begin
       val(s1, values[n], c);
       s1 := '';
       inc(n);
-      end;
-   end;
+      end ;
+   end ;
 if (df = 'D/M/Y') then begin
    d := values[0];
    m := values[1];
@@ -229,7 +321,7 @@ else if (df = 'M/D/Y') then begin
 else if (df = 'Y/M/D') then begin
    if (n = 3) then begin
       y := values[0];
-        m := values[1];
+   	m := values[1];
       d := values[2];
       end
    else if (n = 2) then begin
@@ -238,79 +330,237 @@ else if (df = 'Y/M/D') then begin
       end
    else if (n = 1) then
       d := values[0];
-   end;
+   end ;
 if (n < 3) then begin
    getLocalTime(LocalTime);
-   y := LocalTime.wYear;
+   y := LocalTime.Year;
    if (n < 2) then
-      m := LocalTime.wMonth;
-   end;
+      m := LocalTime.Month;
+   end ;
 if (y >= 0) and (y < 100) then y := 1900 + y;
-StrToDate := DoEncodeDate(y, m, d);
-end;
-
-
-function  StrToTime(const s:string):TDateTime;
-begin
-end;
+Result := DoEncodeDate(y, m, d);
+end ;
 
+{   StrToTime converts the string S to a TDateTime value
+    if S does not represent a valid time value an
+    EConvertError will be raised   }
 
-function  StrToDateTime(const s:string):TDateTime;
-begin
-end;
-
-
-function  DayOfWeek(DateTime:TDateTime):longint;
-begin
-  DayOfWeek := (1 + Trunc(DateTime)) mod 7;
-end;
-
-procedure getlocaltime(var systemtime:tsystemtime);
+function StrToTime(const s: string): TDateTime;
 var
-  wDayOfWeek:word;
-begin
-  getdate(systemtime.wYear,systemtime.wMonth,systemtime.wDay,wDayOfWeek);
-  gettime(systemtime.whour,systemtime.wminute,systemtime.wsecond,systemtime.wmillisecond);
-  systemtime.wmillisecond := systemtime.wmillisecond * 10;
-end;
+   Len, Current: integer; PM: boolean;
+
+   function GetElement: integer;
+   var i, j: integer; c: word;
+   begin
+   result := -1;
+   Inc(Current);
+   while (result = -1) and (Current < Len) do begin
+      if S[Current] in ['0'..'9'] then begin
+         j := Current;
+         while (Current < Len) and (s[Current + 1] in ['0'..'9']) do
+            Inc(Current);
+         val(copy(S, j, 1 + Current - j), result, c);
+         end
+      else if (S[Current] = TimeAMString[1]) or (S[Current] in ['a', 'A']) then begin
+         Current := 1 + Len;
+         end
+      else if (S[Current] = TimePMString[1]) or (S[Current] in ['p', 'P']) then begin
+         Current := 1 + Len;
+         PM := True;
+         end
+      else if (S[Current] = TimeSeparator) or (S[Current] = ' ') then
+         Inc(Current)
+      else exit; // raise EConvertError.Create();
+      end ;
+   end ;
 
-
-function  Date:TDateTime;
 var
-  systemtime:tsystemtime;
+   i: integer;
+   TimeValues: array[0..4] of integer;
+
 begin
-  getlocaltime(systemtime);
-  date := doEncodeDate(systemtime.wYear,systemtime.wMonth,systemtime.wDay);
-end;
+Current := 0;
+Len := length(s);
+PM := False;
+i := 0;
+TimeValues[i] := GetElement;
+while (i < 5) and (TimeValues[i] <> -1) do begin
+   i := i + 1;
+   TimeValues[i] := GetElement;
+   end ;
+if PM then Inc(TimeValues[0], 12);
+result := EncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3]);
+end ;
+
+{   StrToDateTime converts the string S to a TDateTime value
+    if S does not represent a valid date and time value
+    an EConvertError will be raised   }
+
+function StrToDateTime(const s: string): TDateTime;
+var i: integer;
+begin
+i := pos(' ', s);
+if i > 0 then result := StrToDate(Copy(S, 1, i - 1)) + StrToTime(Copy(S, i + 1, length(S)))
+else result := StrToDate(S);
+end ;
 
+{   FormatDateTime formats DateTime to the given format string FormatStr   }
 
-function  Time:TDateTime;
+function FormatDateTime(FormatStr: string; DateTime: TDateTime):string;
+type
+   pstring = ^string;
+const
+   AP: array[0..1] of char = 'ap';
+   TimeAMPMStrings: array[0..1] of pstring = (@TimeAMString, @TimePMString);
 var
-  systemtime:tsystemtime;
+   i: longint;
+   current: string;
+   ch: char;
+   e: longint;
+   y, m, d, h, n, s, ms: word;
+   mDate, mTime: double; Clock12: boolean;
 begin
-  getlocaltime(systemtime);
-  time := doEncodeTime(systemtime.wHour,systemtime.wMinute,
-            systemtime.wSecond,systemtime.wMillisecond) / double(MSecsPerDay);
-end;
+mDate := Int(DateTime);
+mTime := Frac(DateTime);
+DecodeDate(mDate, y, m, d);
+DecodeTime(mTime, h, n, s, ms);
+result := '';
+Clock12 := False;
+i := 0;
+while i < length(FormatStr) do begin
+   i := i + 1;
+   if FormatStr[i] = '"' then begin
+      i := i + 1;
+      while (i < length(FormatStr)) and (FormatStr[i] <> '"') do
+         i := i + 1;
+      end
+   else if FormatStr[i] = '''' then begin
+      i := i + 1;
+      while (i < length(FormatStr)) and (FormatStr[i] <> '''') do
+         i := i + 1;
+      end
+   else if (copy(FormatStr, i, 3) = 'a/p') then begin
+      FormatStr[i] := '"';
+      FormatStr[i + 1] := AP[h div 12];
+      FormatStr[i + 2] := '"';
+      Clock12 := True;
+      i := i + 2;
+      end
+   else if (copy(FormatStr, i, 5) = 'am/pm') then begin
+      Delete(FormatStr, i, 5);
+      if h < 12 then insert('"' + 'am' + '"', FormatStr, i)
+      else insert('"' + 'pm' + '"', FormatStr, i);
+      Clock12 := True;
+      i := i + 3;
+      end
+   else if (copy(FormatStr, i, 4) = 'ampm') then begin
+      Delete(FormatStr, i, 4);
+      current := TimeAMPMStrings[h div 12]^;
+      Insert('"' + current + '"', FormatStr, i);
+      Clock12 := True;
+      i := i + length(current) + 1;
+      end
+   else if copy(FormatStr, i, 2) = 'tt' then begin
+      Delete(FormatStr, i, 2);
+      Insert(LongTimeFormat, FormatStr, i);
+      i := i - 1;
+      end
+   else if FormatStr[i] = 't' then begin
+      Delete(FormatStr, i, 1);
+      Insert(ShortTimeFormat, FormatStr, i);
+      i := i - 1;
+      end
+   else if FormatStr[i] = 'c' then begin
+      Delete(FormatStr, i, 1);
+      Insert(ShortDateFormat + ' ' + ShortTimeFormat, FormatStr, i);
+      i := i - 1;
+      end
+   else if copy(FormatStr, i, 5) = 'ddddd' then begin
+      Delete(FormatStr, i, 5);
+      Insert(ShortDateFormat, FormatStr, i);
+      i := i - 1;
+      end
+   else if copy(FormatStr, i, 6) = 'dddddd' then begin
+      Delete(FormatStr, i, 6);
+      Insert(LongDateFormat, FormatStr, i);
+      i := i - 1;
+      end ;
+   end ;
+current := '';
+i := 1;
+e := 0;
+while not(i > length(FormatStr)) do begin
+   while not(FormatStr[i] in [' ','"','/',':','''']) and not(i > length(FormatStr)) do begin
+      current := current + FormatStr[i];
+      inc(i);
+      end ;
+   if (current <> '') then begin
+      if (mTime <> 0) then begin
+         if (current = 'h') then begin
+            if clock12 then result := result + IntToStr(h mod 12)
+				else result := result + IntToStr(h);
+            end
+         else if (current = 'hh') then begin
+            if clock12 then result := result + RightStr('0' + IntToStr(h mod 12), 2)
+            else result := result + RightStr('0' + IntToStr(h), 2);
+            end
+         else if (current = 'n') then result := result + IntToStr(n)
+         else if (current = 'nn') then result := result + RightStr('0' + IntToStr(n), 2)
+         else if (current = 's') then result := result + IntToStr(s)
+         else if (current = 'ss') then result := result + RightStr('0' + IntToStr(s), 2);
+         end ;
+      if (mDate <> 0) then begin
+         if (current = 'd') then result := result + IntToStr(d)
+         else if (current = 'dd') then result := result + RightStr('0' + IntToStr(d), 2)
+         else if (current = 'ddd') then result := result + ShortDayNames[DayOfWeek(DateTime)]
+         else if (current = 'dddd') then result := result + LongDayNames[DayOfWeek(DateTime)]
+         else if (current = 'm') then result := result + IntToStr(m)
+         else if (current = 'mm') then result := result + RightStr('0' + IntToStr(m), 2)
+         else if (current = 'mmm') then result := result + ShortMonthNames[m]
+         else if (current = 'mmmm') then result := result + LongMonthNames[m]
+         else if (current = 'y') then result := result + IntToStr(y)
+         else if (current = 'yy') then result := result + RightStr(IntToStr(y), 2)
+         else if (current = 'yyyy') or (current = 'yyy') then result := result + IntToStr(y);
+         end ;
+      current := '';
+      end ;
+   if FormatStr[i] = ' ' then result := result + ' '
+   else if (FormatStr[i] = '/') and (mDate <> 0) then result := result + DateSeparator
+   else if (FormatStr[i] = ':') and (mTime <> 0) then result := result + TimeSeparator
+   else if (FormatStr[i] in ['"', '''']) then begin
+      ch := FormatStr[i];
+      inc(i);
+      while (i <= length(FormatStr)) and (FormatStr[i] <> ch) do begin
+         result := result + FormatStr[i];
+         inc(i);
+         end ;
+      end ;
+   inc(i);
+   end ;
+end ;
 
+{   DateTimeToString formats DateTime to the given format in FormatStr   }
 
-function  Now:TDateTime;
-var
-  systemtime:tsystemtime;
+procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
 begin
-  getlocaltime(systemtime);
-  now := doEncodeDate(systemtime.wYear,systemtime.wMonth,systemtime.wDay) +
-         doEncodeTime(systemtime.wHour,systemtime.wMinute,
-           systemtime.wSecond,systemtime.wMillisecond) / double(MSecsPerDay);
-end;
+Result := FormatDateTime(FormatStr, DateTime);
+end ;
 
 {
   $Log$
-  Revision 1.2  1998-09-09 15:29:04  peter
-    * removed some warnings
+  Revision 1.3  1998-09-16 08:28:36  michael
+  Update from gertjan Schouten, plus small fix for linux
 
   Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
 
-}
+  1998/08/25 Gertjan
+  + uses Go32 instead of Dos unit
+    GetLocalTime
+    DayOfWeek
+    DoDecodeDate
+    DoEncodeDate
+    FormatDateTime
+}
+

rtl/objpas/datih.inc

@@ -26,20 +26,20 @@ const
    SecsPerDay = 24 * 60 * 60; // Seconds and milliseconds per day
    MSecsPerDay = SecsPerDay * 1000;
 
-   DateDelta = 693594; // Days between 1/1/0001 and 12/31/1899
-   DateSeparator:char='-';
-   TimeSeparator:char=':';
-   TimeAMString: pchar = 'am';
-   TimePMString: pchar = 'pm';
-   ShortMonthNames: array[1..12] of pchar =
+   DateDelta = 693594;        // Days between 1/1/0001 and 12/31/1899
+   DateSeparator: char = '-';
+   TimeSeparator: char = ':';
+   TimeAMString: string = 'am';
+   TimePMString: string = 'pm';
+   ShortMonthNames: array[1..12] of string =
      ('jan','feb','mar','apr','mai','jun',
       'jul','aug','sep','oct','nov','dec');
-   LongMonthNames: array[1..12] of pchar=
+   LongMonthNames: array[1..12] of string =
      ('january','february','march','april','mai','june',
       'july','august','september','october','november','december');
-   ShortDayNames: array[1..7] of pchar=
+   ShortDayNames: array[1..7] of string =
      ('sun','mon','tue','wen','thu','fri','sat');
-   LongDayNames: array[1..7] of pchar=
+   LongDayNames: array[1..7] of string =
      ('sunday','monday','tuesday','wednesday','thursday','friday','saturday');
 
    {  date time formatting characters:
@@ -73,47 +73,59 @@ const
       'xx'   : literal text
    }
 
-// these constant strings will be changed to pchars too, someday :)
-   ShortDateFormat:string='d/m/y';
-   LongDateFormat:string='dd" "mmmm" "yyyy';
-   ShortTimeFormat:string='hh:nn';
-   LongTimeFormat:string='hh:nn:ss';
+   ShortDateFormat: string = 'd/m/y';
+   LongDateFormat: string = 'dd" "mmmm" "yyyy';
+   ShortTimeFormat: string = 'hh:nn';
+   LongTimeFormat: string = 'hh:nn:ss';
 
-   Eoln = #10; // or should that be #13, or $0d0a
+   Eoln = #10;
 
 type
-   TSystemTime=record
-      wYear:word;wMonth:word;wDay:word;
-      wHour:word;wMinute:word;wSecond:word;wMilliSecond:word;
+   TSystemTime = record
+      Year, Month, Day: word;
+      Hour, Minute, Second, MilliSecond: word;
    end ;
+
    TDateTime = double;
 
-{  Date and Time functions  }
-
-function  DateToStr(Date:TDateTime):string;
-function  TimeToStr(Time:TDateTime):string;
-function  DateTimeToStr(DateTime:TDateTime):string;
-function  EncodeDate(Year, Month, Day :word):TDateTime;
-function  EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
-procedure DecodeDate(Date:TDateTime;var Year:word;var Month:word;var Day:word);
-procedure DecodeTime(Time:TDateTime;var Hour:word;var Minute:word;var Second:word;var MilliSecond:word);
-function  FormatDateTime(FormatStr:string;DateTime:TDateTime):string;
-function  StrToDate(const s:string):TDateTime;
-function  StrToTime(const s:string):TDateTime;
-function  StrToDateTime(const s:string):TDateTime;
-function  DayOfWeek(DateTime:TDateTime):longint;
-function  Date:TDateTime;
-function  Time:TDateTime;
-function  Now:TDateTime;
-procedure GetLocalTime(var systemtime:tsystemtime);
+   TTimeStamp = record
+      Time: integer;   { Number of milliseconds since midnight }
+      Date: integer;   { One plus number of days since 1/1/0001 }
+   end ;
 
+function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
+function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
+function MSecsToTimeStamp(MSecs: Comp): TTimeStamp;
+function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
+function EncodeDate(Year, Month, Day :word): TDateTime;
+function EncodeTime(Hour, Minute, Second, MilliSecond:word): TDateTime;
+procedure DecodeDate(Date: TDateTime; var Year, Month, Day: word);
+procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
+procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime);
+function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
+function DayOfWeek(DateTime: TDateTime): integer;
+function Date: TDateTime;
+function Time: TDateTime;
+function Now: TDateTime;
+function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer): TDateTime;
+function IsLeapYear(Year: Word): boolean;
+function DateToStr(Date: TDateTime): string;
+function TimeToStr(Time: TDateTime): string;
+function DateTimeToStr(DateTime: TDateTime): string;
+function StrToDate(const S: string): TDateTime;
+function StrToTime(const S: string): TDateTime;
+function StrToDateTime(const S: string): TDateTime;
+function FormatDateTime(FormatStr: string; DateTime: TDateTime):string;
+procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
 
 {
 
   $Log$
-  Revision 1.1  1998-04-10 15:17:46  michael
+  Revision 1.2  1998-09-16 08:28:37  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+  Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
 
-
 }

rtl/objpas/fina.inc

@@ -21,86 +21,74 @@
     System Utilities For Free Pascal
 }
 
-
-type
-   PByte=^Byte;
-   PWord=^Word;
-   PLongint=^Longint;
-
-const
-   DayTable:array[Boolean,1..12] of longint =
-      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
-       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
-   HexDigits: array[0..15] of char = '0123456789ABCDEF';
-
-function ChangeFileExt(FileName, Extension: string): string;
+function ChangeFileExt(const FileName, Extension: string): string;
 var i: longint;
 begin
 I := Length(FileName);
-while (I > 0) and not (FileName[I] in ['.', '\', ':']) do Dec(I);
+while (I > 0) and not(FileName[I] in ['/', '.', '\', ':']) do Dec(I);
 if (I = 0) or (FileName[I] <> '.') then I := 255;
-ChangeFileExt := Copy(FileName, 1, I - 1) + Extension;
+Result := Copy(FileName, 1, I - 1) + Extension;
 end;
 
-function ExtractFilePath(FileName: string): string;
+function ExtractFilePath(const FileName: string): string;
 var i: longint;
 begin
 i := Length(FileName);
-while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
-ExtractFilePath := Copy(FileName, 1, I);
+while (i > 0) and not (FileName[i] in ['/', '\', ':']) do Dec(i);
+Result := Copy(FileName, 1, i);
 end;
 
-function ExtractFileDir(FileName: string): string;
+function ExtractFileDir(const FileName: string): string;
 var i: longint;
 begin
 I := Length(FileName);
-while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
-if (I > 1) and (FileName[I] = '\') and
-    not (FileName[I - 1] in ['\', ':']) then Dec(I);
-ExtractFileDir := Copy(FileName, 1, I);
+while (I > 0) and not (FileName[I] in ['/', '\', ':']) do Dec(I);
+if (I > 1) and (FileName[I] in ['\', '/']) and
+   not (FileName[I - 1] in ['/', '\', ':']) then Dec(I);
+Result := Copy(FileName, 1, I);
 end;
 
-function ExtractFileDrive(FileName: string): string;
-var i, j: longint;
+function ExtractFileDrive(const FileName: string): string;
+var i: longint;
 begin
 if (Length(FileName) >= 3) and (FileName[2] = ':') then
-   ExtractFileDrive := Copy(FileName, 1, 2)
-else if (Length(FileName) >= 2) and (FileName[1] = '\') and
-   (FileName[2] = '\') then begin
-   J := 0;
-   I := 3;
-   While (I < Length(FileName)) and (J < 2) do begin
-      if FileName[I] = '\' then Inc(J);
-      if J < 2 then Inc(I);
-      end;
-   if FileName[I] = '\' then Dec(I);
-   ExtractFileDrive := Copy(FileName, 1, I);
-   end else ExtractFileDrive := '';
+   result := Copy(FileName, 1, 2)
+else if (Length(FileName) >= 2) and (FileName[1] in ['/', '\']) and
+   (FileName[2] in ['/', '\']) then begin
+   i := 2;
+   While (i < Length(Filename)) do begin
+	   if Filename[i + 1] in ['/', '\'] then break;
+      inc(i);
+      end ;
+   Result := Copy(FileName, 1, i);
+   end
+else Result := '';
 end;
 
-function ExtractFileName(FileName: string): string;
+function ExtractFileName(const FileName: string): string;
 var i: longint;
 begin
 I := Length(FileName);
-while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
-ExtractFileName := Copy(FileName, I + 1, 255);
+while (I > 0) and not (FileName[I] in ['/', '\', ':']) do Dec(I);
+Result := Copy(FileName, I + 1, 255);
 end;
 
-function ExtractFileExt(FileName: string): string;
+function ExtractFileExt(const FileName: string): string;
 var i: longint;
 begin
 I := Length(FileName);
-while (I > 0) and not (FileName[I] in ['.', '\', ':']) do Dec(I);
+while (I > 0) and not (FileName[I] in ['.', '/', '\', ':']) do Dec(I);
 if (I > 0) and (FileName[I] = '.') then
-   ExtractFileExt := Copy(FileName, I, 255)
-else ExtractFileExt := '';
+   Result := Copy(FileName, I, 255)
+else Result := '';
 end;
 
-
 {
   $Log$
-  Revision 1.1  1998-04-10 15:17:46  michael
+  Revision 1.2  1998-09-16 08:28:38  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+  Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
-
-}
+}

rtl/objpas/finah.inc

@@ -21,18 +21,20 @@
     System Utilities For Free Pascal
 }
 
-{ Filename Functions }
-
-function ChangeFileExt(FileName, Extension: string): string;
-function ExtractFilePath(FileName: string): string;
-function ExtractFileDrive(FileName: string): string;
-function ExtractFileName(FileName: string): string;
-function ExtractFileExt(FileName: string): string; { Returns file extension like '.123' }
+function ChangeFileExt(const FileName, Extension: string): string;
+function ExtractFilePath(const FileName: string): string;
+function ExtractFileDrive(const FileName: string): string;
+function ExtractFileName(const FileName: string): string;
+function ExtractFileExt(const FileName: string): string; { Returns file extension like '.123' }
 
 {
   $Log$
-  Revision 1.1  1998-04-10 15:17:46  michael
+  Revision 1.2  1998-09-16 08:28:39  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+  Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
 
 }
+

rtl/objpas/syspch.inc

@@ -23,266 +23,350 @@
 
 {  PChar functions  }
 
-function  NewStr(s:string):pchar;
-var p:pchar;l:longint;
+type
+   pbyte = ^byte;
+   CharArray = array[0..0] of char;
+
+{  StrLen returns the length of Str ( terminator not included )  }
+
+function StrLen(Str: PChar): cardinal;
 begin
-l := length(s);
-p := StrAlloc(l + 1);
-move(s[1], p^, l);
-byte(pchar(p + l)^) := 0;
-NewStr := p;
+result := 0;
+if Str <> nil then begin
+   while CharArray(Str^)[result] <> #0 do
+      result := result + 1;
+   end ;
 end ;
 
-function  StrAlloc(Size:longint):pchar;
-var p:pointer;
+{  StrEnd returns a pointer to the last character (terminator) of Str  }
+
+function StrEnd(Str: PChar): PChar;
 begin
-Getmem(p, size + sizeof(longint));
-Move(Size, p^, sizeof(longint));
-pbyte(p + sizeof(longint))^ := 0;
-StrAlloc := pchar(p + sizeof(longint));
+result := Str;
+if Str <> nil then begin
+   while result^ <> #0 do
+      result := result + 1;
+   end ;
 end ;
 
-procedure StrDispose(var p:pchar);
-var l:longint;
+{  StrMove copies Count bytes from source to dest, source and dest may overlap.   }
+
+function StrMove(Dest, Source: PChar; Count: cardinal): PChar;
 begin
-if (p = nil) then exit;
-p := pchar(p - sizeof(longint));
-move(p^, l, sizeof(longint));
-freemem(p, l + sizeof(longint));
-p := nil;
+result := Dest;
+if (Dest <> nil) and (Source <> nil) and (Count > 0) then
+   move(Source^, Dest^, Count);
 end ;
 
-function StrPas(p:pchar):string;
+{  StrCopy copies StrLen(Source) characters from Source to Dest and returns Dest  }
+
+function StrCopy(Dest, Source: PChar): PChar;
+begin
+result := StrMove(Dest, Source, 1 + StrLen(Source));  {  copy nul character too !  }
+end ;
+
+{  StrECopy copies StrLen(Source) characters from Source to Dest and returns StrEnd(Dest)  }
+
+function StrECopy(Dest, Source: PChar): PChar;
+begin
+StrMove(Dest, Source, 1 + StrLen(Source));
+result := StrEnd(Dest);
+end ;
+
+{  StrLCopy copies MaxLen or less characters from Source to Dest and returns Dest  }
+
+function StrLCopy(Dest, Source: PChar; MaxLen: cardinal): PChar;
+var count: cardinal;
 begin
-   asm
-      movl  P,%eax
-      movl  %eax,%esi
-      movl  __RESULT,%eax
-      movl  %eax,%edi
-      pushl %edi
-      incl  %edi
-      xorl  %eax,%eax
-      movw  $255,%cx
-   STR_LOOP1:
-      lodsb
-      orb   %al,%al
-      jz    STR_END
-      stosb
-      loop  STR_LOOP1
-   STR_END:
-      popl  %edi
-      movw  $255,%ax
-      subw  %cx,%ax
-      movb  %al,(%edi)
+result := Dest;
+if result <> Nil then begin
+   count := StrLen(Source);
+   if count > MaxLen then
+      count := MaxLen;
+   StrMove(Dest, Source, count);
+   CharArray(result^)[Count] := #0; { terminate ! }
    end ;
 end ;
 
-function  StrLen(p:pchar):longint;
+{  StrPCopy copies the pascal string Source to Dest and returns Dest  }
+
+function StrPCopy(Dest: PChar; Source: string): PChar;
 begin
-	asm
-      movl  p,%eax
-      movl  %eax,%esi
-      xorl  %eax,%eax
-      movl  $0xFFFFFFFF,%ecx
-   STRLEN_LOOP:
-      incl  %ecx
-      lodsb
-      orb   %al,%al
-      jnz   STRLEN_LOOP
-      movl  %ecx,__RESULT
+result := StrMove(Dest, PChar(@Source[1]), length(Source));
+end ;
+
+{  StrPLCopy copies MaxLen or less characters from the pascal string
+   Source to Dest and returns Dest  }
+
+function StrPLCopy(Dest: PChar; Source: string; MaxLen: cardinal): PChar;
+var Count: cardinal;
+begin
+result := Dest;
+if (Result <> Nil) and (MaxLen <> 0) then begin
+   Count := Length(Source);
+   if Count > MaxLen then
+      Count := MaxLen;
+   StrMove(Dest, PChar(@Source[1]), Count);
+   CharArray(result^)[Count] := #0;  { terminate ! }
    end ;
 end ;
 
-function  StrEnd(p:pchar):pchar;
+{  StrCat concatenates Dest and Source and returns Dest  }
+
+function StrCat(Dest, Source: PChar): PChar;
+begin
+result := Dest;
+StrMove(StrEnd(Dest), Source, 1 + StrLen(Source)); {  include #0  }
+end ;
+
+{  StrLCat concatenates Dest and MaxLen - StrLen(Dest) (or less) characters
+   from Source, and returns Dest   }
+
+function StrLCat(Dest, Source: PChar; MaxLen: cardinal): PChar;
+var Count: cardinal; P: PChar;
 begin
-   asm
-      movl  p,%eax
-      movl  %eax,%esi
-   STREND_LOOP:
-      lodsb
-      orb   %al,%al
-      jnz   STREND_LOOP
-      movl  %esi,__RESULT
+result := Dest;
+if (Dest <> nil) and (MaxLen <> 0) then begin
+   P := StrEnd(Dest);
+   Count := StrLen(Source);
+   if Count > MaxLen - (P - Dest) then
+      Count := MaxLen - (P - Dest);
+   if Count <> 0 then begin
+      StrMove(P, Source, Count);
+      CharArray(p^)[Count] := #0;       {  terminate Dest  }
+      end ;
    end ;
 end ;
 
-function  StrMove(Dest, Source: PChar; Count: longint): PChar;
+{  StrComp returns 0 if Str1 and Str2 are equal,
+   a value less than 0 in case Str1 < Str2
+   and a value greater than 0 in case Str1 > Str2  }
+
+function StrComp(Str1, Str2: PChar): integer;
 begin
-   asm
-      movl    source,%eax
-      movl    %eax,%esi
-      movl    dest,%eax
-      movl    %eax,%edi
-      movl    %edi,__RESULT
-      movl    COUNT,%ecx
-      movl    %ecx,%edx
-      cmpl    %esi,%edi
-      jg      STRMOVE_BACK
-      shrl    $2,%ecx
-      rep
-		movsl
-      movl    %edx,%ecx
-      andl    $3,%ecx
-      rep
-		movsb
-      jmp     STRMOVE_END
-   STRMOVE_BACK:
-      addl    %ecx,%edi
-      decl    %edi
-      addl    %ecx,%esi
-      decl    %esi
-      andl    $3,%ecx
-      STD
-      rep
-		movsb
-      subl    $3,%esi
-      subl    $3,%edi
-      movl    %edx,%ecx
-      shrl    $2,%ecx
-      rep
-		movsl
-      CLD
-   STRMOVE_END:
+result := 0;
+if (Str1 <> Nil) and (Str2 <> Nil) then begin
+   while result = 0 do begin
+      result := byte(Str1^) - byte(Str2^);
+      if (Str1^ = #0) or (Str2^ = #0) then break;
+      Str1 := Str1 + 1;
+      Str2 := Str2 + 1;
+      end ;
    end ;
 end ;
 
-function  StrCat(Dest, Source: PChar): PChar;
+{  StrIComp returns 0 if Str1 and Str2 are equal,
+   a value less than 0 in case Str1 < Str2
+   and a value greater than 0 in case Str1 > Str2;
+   comparison is case insensitive  }
+
+function StrIComp(Str1, Str2: PChar): integer;
+var Chr1, Chr2: byte;
 begin
-StrCat := Dest;
-while char(dest^) <> #0 do
-   dest := dest + 1;
-while char(source^) <> #0 do begin
-   char(dest^) := char(source^);
-   dest := dest + 1;
-   source := source + 1;
+result := 0;
+if (Str1 <> Nil) and (Str2 <> Nil) then begin
+   while result = 0 do begin
+      Chr1 := byte(Str1^);
+      Chr2 := byte(Str2^);
+      if Chr1 in [97..122] then Chr1 := Chr1 - 32;
+      if Chr2 in [97..122] then Chr2 := Chr2 - 32;
+      result := Chr1 - Chr2;
+      if (Chr1 = 0) or (Chr2 = 0) then break;
+      Str1 := Str1 + 1;
+      Str2 := Str2 + 1;
+      end ;
    end ;
-char(dest^) := #0;
 end ;
 
-function  StrCat(Dest:pchar; Source: string): PChar;
-var l:longint;
+{  StrLComp returns 0 if Str1 and Str2 are equal,
+   a value less than 0 in case Str1 < Str2
+   and a value greater than 0 in case Str1 > Str2;
+   MaxLen or less characters are compared  }
+
+function StrLComp(Str1, Str2: PChar; MaxLen: cardinal): integer;
+var I: integer;
 begin
-StrCat := Dest;
-while char(dest^) <> #0 do
-   dest := dest + 1;
-l := length(source);
-move(source[1], dest^, l);
-dest := dest + l;
-char(dest^) := #0;
+result := 0;
+if (Str1 <> Nil) and (Str2 <> Nil) then begin
+   I := 0;
+   while (I < MaxLen) and (result = 0) do begin
+      result := byte(Str1^) - byte(Str2^);
+      if (Str1^ = #0) or (Str2^ = #0) then break;
+      Str1 := Str1 + 1;
+      Str2 := Str2 + 1;
+      I := I + 1;
+      end ;
+   end ;
 end ;
 
-function  StrCat(var Dest:string; Source: pchar): String;
-var count,l:longint;
+{  StrLIComp returns 0 if Str1 and Str2 are equal,
+   a value less than 0 in case Str1 < Str2
+   and a value greater than 0 in case Str1 > Str2;
+   comparison is case insensitive and MaxLen or less characters are compared  }
+
+function StrLIComp(Str1, Str2: PChar; MaxLen: cardinal): integer;
+var Chr1, Chr2: byte; I: integer;
 begin
-l := length(Dest);
-count := setLength(Dest, l + StrLen(Source)) - l;
-if (count > 0) then
-   move(source^, dest[l + 1], count);
-StrCat := Dest;
+result := 0;
+if (Str1 <> Nil) and (Str2 <> Nil) then begin
+   I := 0;
+   while (I < MaxLen) and (result = 0) do begin
+      Chr1 := byte(Str1^);
+      Chr2 := byte(Str2^);
+      if Chr1 in [97..122] then Chr1 := Chr1 - 32;
+      if Chr2 in [97..122] then Chr2 := Chr2 - 32;
+      result := Chr1 - Chr2;
+      if (Chr1 = 0) or (Chr2 = 0) then break;
+      Str1 := Str1 + 1;
+      Str2 := Str2 + 1;
+      I := I + 1;
+      end ;
+   end ;
 end ;
 
-function  StrIns(Dest:pchar; Source: string): PChar;
-var len:longint;
+{  StrScan returns a PChar to the first character Chr in Str   }
+
+function StrScan(Str: PChar; Chr: char): PChar;
+var P: PChar;
 begin
-len := length(Source);
-StrMove(dest + len, dest, 1 + strlen(dest));
-Move(Source[1], dest^, len);
-StrIns := dest;
+result := Nil;
+if Str <> Nil then begin
+   P := Str;
+   while (P^ <> #0) and (P^ <> Chr) do
+      P := P + 1;
+   if P^ = Chr then result := P;
+   end ;
 end ;
 
-function  StrCopy(Dest, Source: PChar): Pchar;
+{  StrRScan returns a PChar to the last character Chr in Str   }
+
+function StrRScan(Str: PChar; Chr: char): PChar;
+var P: PChar;
 begin
-   asm
-      movl    Dest,%eax
-      movl    %eax,%edi
-      movl    %eax,__RESULT
-      movl    Source,%eax
-      movl    %eax,%esi
-   STRCOPY_LOOP:
-      lodsb
-      stosb
-      orb     %al,%al
-      jnz     STRCOPY_LOOP
+result := Nil;
+if Str <> Nil then begin
+   P := StrEnd(Str);
+   While (P^ <> Chr) and (P <> Str) do
+      P := P - 1;
+   If P^ = Chr then result := P;
    end ;
 end ;
 
-function  StrLCopy(Dest, Source: PChar; MaxLen: longint): PChar;
+{  StrPos returns a PChar to the first occurance of Str2 contained in Str1
+   if no occurance can be found StrPos returns Nil  }
+
+function StrPos(Str1, Str2: PChar): PChar;
+var E: PChar; Count1, Count2: Cardinal;
 begin
-   asm
-      movl    Dest,%eax
-      movl    %eax,__RESULT
-      movl    %eax,%edi
-      movl    Source,%eax
-      movl    %eax,%esi
-      movl    MaxLen,%ecx
-      orl     %ecx,%ecx
-      jz      STRLCOPY_END
-   STRLCOPY_LOOP:
-      lodsb
-      orb     %al,%al
-      jz      STRLCOPY_END
-      stosb
-      loop    STRLCOPY_LOOP
-   STRLCOPY_END:
-      xorb    %al,%al
-      stosb
+Count1 := StrLen(Str1);
+Count2 := StrLen(Str2);
+if (Str1 <> Nil) and (Str2 <> Nil) and (Count1 > 0) and (Count1 >= Count2) then begin
+   E := Str1 + 1 + Count1 - Count2;
+   result := Str1;
+   While result <> E do begin
+      if StrLComp(result, Str2, Count2) = 0 then
+         exit;
+      result := result + 1;
+      end ;
    end ;
+result := Nil;
 end ;
 
-function  StrScan(str:pchar;ch:char):pchar;
+{  StrUpper converts all lowercase characters in Str to uppercase  }
+
+function StrUpper(Str: PChar): PChar;
 begin
-   asm
-      movl    str,%eax
-      movl    %eax,%esi
-      movb    ch,%bl
-   STRSCAN_LOOP:
-      lodsb
-      cmpb    %al,%bl
-      je      STRSCAN_END
-      orb     %al,%al
-      jnz     STRSCAN_LOOP
-   STRSCAN_END:
-      decl    %esi
-      movl    %esi,__RESULT
+Result := Str;
+if Str <> Nil then begin
+   While Str^ <> #0 do begin
+      if Str^ in ['a'..'z'] then
+         dec(byte(Str^), 32);
+      Str := Str + 1;
+      end ;
    end ;
 end ;
 
-function  StrRScan(str:pchar;ch:char):pchar;
+{  StrLower converts all uppercase characters in Str to lowercase  }
+
+function StrLower(Str: PChar): PChar;
 begin
-   asm
-      movl    str,%eax
-      movl    %eax,%esi
-      movl    %eax,%edx
-      movb    ch,%bl
-   STRRSCAN_LOOP:
-      lodsb
-      cmpb    %al,%bl
-      jne     STRRSCAN_NOTFOUND
-      movl    %esi,%edx
-      decl    %edx
-   STRRSCAN_NOTFOUND:
-      orb     %al,%al
-      jnz     STRRSCAN_LOOP
-      movl    %edx,__RESULT
+Result := Str;
+if Str <> Nil then begin
+   While Str^ <> #0 do begin
+      if Str^ in ['A'..'Z'] then
+         inc(byte(Str^), 32);
+      Str := Str + 1;
+      end ;
    end ;
 end ;
 
-function  StrTer(str:pchar;l:longint):pchar;
+{  StrPas converts a PChar to a pascal string  }
+
+function StrPas(Str: PChar): string;
 begin
-   asm
-   	movl    str,%eax
-      movl    %eax,__RESULT
-      addl    l,%eax
-      movl    %eax,%edi
-      xorb    %al,%al
-      movb    %al,(%edi)
+SetLength(result, StrLen(Str));
+Move(Str^, result[1], Length(result));
+end ;
+
+{  StrAlloc allocates a buffer of Size + 4
+   the size of the allocated buffer is stored at result - 4
+   StrDispose should be used to destroy the buffer  }
+
+function StrAlloc(Size: cardinal): PChar;
+var Temp: pointer;
+begin
+GetMem(Temp, Size + SizeOf(cardinal));
+Move(Size, Temp^, SizeOf(cardinal));
+pbyte(Temp + SizeOf(cardinal))^ := 0;
+result := PChar(Temp + SizeOf(cardinal));
+end ;
+
+{  StrBufSize returns the amount of memory allocated for pchar Str allocated with StrAlloc  }
+
+function StrBufSize(var Str: PChar): cardinal;
+begin
+if Str <> Nil then
+   result := Cardinal(pointer(Str - SizeOf(cardinal))^)
+else
+   result := 0;
+end ;
+
+{  StrNew creates an exact copy of Str   }
+
+function StrNew(Str: PChar): PChar;
+begin
+if Str <> Nil then begin
+   result := StrAlloc(1 + StrLen(Str));
+   StrCopy(result, Str);
+   end
+else result := Nil;
+end ;
+
+{   StrDispose clears the memory allocated with StrAlloc   }
+
+procedure StrDispose(var Str: PChar);
+var Size: cardinal;
+begin
+if (Str <> Nil) then begin
+   Str := PChar(Str - SizeOf(cardinal));
+   Move(Str^, Size, SizeOf(cardinal));
+   FreeMem(Str, Size + SizeOf(cardinal));
+   Str := Nil;
    end ;
 end ;
 
 {
   $Log$
-  Revision 1.1  1998-04-10 15:17:46  michael
+  Revision 1.2  1998-09-16 08:28:40  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+
+  1998/08/26 Gertjan
+  Most functions rewritten in pascal.
+
+  Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
 
+
 }

rtl/objpas/syspchh.inc

@@ -21,29 +21,39 @@
     System Utilities For Free Pascal
 }
 
-
-function  NewStr(s:string):pchar;
-function  StrAlloc(Size:longint):pchar;
-procedure StrDispose(var p:pchar);
-function  StrPas(p:pchar):string;
-function  StrLen(p:pchar):longint;
-function  StrEnd(p:pchar):pchar;
-function  StrCat(Dest, Source:pchar): PChar;
-function  StrCat(Dest:pchar; Source: string): PChar;
-function  StrCat(var Dest:string; Source: pchar): String;
-function  StrIns(Dest:pchar; Source: string): PChar;
-function  StrMove(Dest, Source: PChar; Count: longint): PChar;
-function  StrCopy(Dest, Source: PChar): Pchar;
-function  StrLCopy(Dest, Source: PChar; MaxLen: longint): PChar;
-function  StrScan(str:pchar;ch:char):PChar;
-function  StrRScan(str:pchar;ch:char):PChar;
-function  StrTer(str:pchar;l:longint):pchar;
-
+function StrLen(Str: PChar): cardinal;
+function StrEnd(Str: PChar): PChar;
+function StrMove(Dest, Source: PChar; Count: cardinal): PChar;
+function StrCopy(Dest, Source: PChar): PChar;
+function StrECopy(Dest, Source: PChar): PChar;
+function StrLCopy(Dest, Source: PChar; MaxLen: cardinal): PChar;
+function StrPCopy(Dest: PChar; Source: string): PChar;
+function StrPLCopy(Dest: PChar; Source: string; MaxLen: cardinal): PChar;
+function StrCat(Dest, Source: PChar): PChar;
+function StrLCat(Dest, Source: PChar; MaxLen: cardinal): PChar;
+function StrComp(Str1, Str2: PChar): integer;
+function StrIComp(Str1, Str2: PChar): integer;
+function StrLComp(Str1, Str2: PChar; MaxLen: cardinal): integer;
+function StrLIComp(Str1, Str2: PChar; MaxLen: cardinal): integer;
+function StrScan(Str: PChar; Chr: char): PChar;
+function StrRScan(Str: PChar; Chr: char): PChar;
+function StrPos(Str1, Str2: PChar): PChar;
+function StrUpper(Str: PChar): PChar;
+function StrLower(Str: PChar): PChar;
+function StrPas(Str: PChar): string;
+function StrAlloc(Size: cardinal): PChar;
+function StrBufSize(var Str: PChar): cardinal;
+function StrNew(Str: PChar): PChar;
+procedure StrDispose(var Str: PChar);
 
 {
   $Log$
-  Revision 1.1  1998-04-10 15:17:46  michael
+  Revision 1.2  1998-09-16 08:28:41  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+  Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
 
 }
+

rtl/objpas/sysstr.inc

@@ -21,120 +21,506 @@
     System Utilities For Free Pascal
 }
 
-{ string manipulation functions }
+{   NewStr creates a new PString and assigns S to it
+    if length(s) = 0 NewStr returns Nil   }
 
-function setLength(var s:string; newLength:longint):longint;
+function NewStr(const S: string): PString;
 begin
-if (newLength > 255) then
-   newLength := 255;
-s[0] := char(newLength);
-setLength := ord(s[0]);
+result := Nil;
+{
+if Length(S) <> 0 then begin
+   result := New(PString);
+   result^ := S;
+   end ;
+}
+end ;
+
+{   DisposeStr frees the memory occupied by S   }
+
+procedure DisposeStr(S: PString);
+begin
+{
+if S <> Nil then begin
+   Dispose(S);
+   S := Nil;
+   end ;
+}
 end ;
 
-function UpperCase(s: string): string;
-var l:longint;
+{   AssignStr assigns S to P^   }
+
+procedure AssignStr(var P: PString; const S: string);
+begin
+P^ := s;
+end ;
+
+{   AppendStr appends S to Dest   }
+
+procedure AppendStr(var Dest: PString; const S: string);
+begin
+Dest^ := Dest^ + S;
+end ;
+
+{   UpperCase returns a copy of S where all lowercase characters ( from a to z )
+    have been converted to uppercase   }
+
+function UpperCase(const S: string): string;
+var i: integer;
 begin
-l := Length(S);
-while l <> 0 do begin
-   if (s[l] in ['a'..'z']) then s[l] := char(byte(s[l]) - 32);
-   dec(l);
+result := S;
+i := Length(S);
+while i <> 0 do begin
+   if (result[i] in ['a'..'z']) then result[i] := char(byte(result[i]) - 32);
+   Dec(i);
    end;
-uppercase := s;
 end;
 
-function LowerCase(s: string): string;
-var l:longint;
+{   LowerCase returns a copy of S where all uppercase characters ( from A to Z )
+    have been converted to lowercase  }
+
+function LowerCase(const S: string): string;
+var i: integer;
 begin
-l := Length(S);
-while l <> 0 do begin
-   if (s[l] in ['A'..'Z']) then s[l] := char(byte(s[l]) + 32);
-   dec(l);
+result := S;
+i := Length(result);
+while i <> 0 do begin
+   if (result[i] in ['A'..'Z']) then result[i] := char(byte(result[i]) + 32);
+   dec(i);
    end;
-LowerCase := s;
 end;
 
-{!$I ANSI.PPI}
+{   CompareStr compares S1 and S2, the result is the based on
+    substraction of the ascii values of the characters in S1 and S2
+    case     result
+    S1 < S2  < 0
+    S1 > S2  > 0
+    S1 = S2  = 0     }
 
-function AnsiUpperCase(s: string):string;
+function CompareStr(const S1, S2: string): Integer;
+var i, count, count1, count2: integer;
 begin
+result := 0;
+Count1 := Length(S1);
+Count2 := Length(S2);
+if Count1 > Count2 then Count := Count2
+else Count := Count1;
+result := CompareMem(@S1[1], @S2[1], Count);
+if (result = 0) and (Count1 <> Count2) then begin
+   if Count1 > Count2 then result := ord(s1[Count1 + 1])
+   else result := -ord(s2[Count2 + 1]);
+   end ;
 end ;
 
-function AnsiLowerCase(s: string):string;
+{   CompareMem returns the result of comparison of Length bytes at P1 and P2
+    case       result
+    P1 < P2    < 0
+    P1 > P2    > 0
+    P1 = P2    = 0    }
+
+function CompareMem(P1, P2: Pointer; Length: cardinal): integer;
+var i: integer;
 begin
+i := 0;
+result := 0;
+while (result = 0) and (i < length) do begin
+   result := byte(P1^) - byte(P2^);
+   P1 := P1 + 1;
+   P2 := P2 + 1;
+   i := i + 1;
+   end ;
+end ;
+
+{   CompareText compares S1 and S2, the result is the based on
+    substraction of the ascii values of characters in S1 and S2
+    comparison is case-insensitive
+    case     result
+    S1 < S2  < 0
+    S1 > S2  > 0
+    S1 = S2  = 0     }
+
+function CompareText(const S1, S2: string): integer;
+var i, count, count1, count2: integer; Chr1, Chr2: byte;
+begin
+result := 0;
+Count1 := Length(S1);
+Count2 := Length(S2);
+if Count1 > Count2 then Count := Count2
+else Count := Count1;
+i := 0;
+while (result = 0) and (i < count) do begin
+   i := i + 1;
+   Chr1 := byte(s1[i]);
+   Chr2 := byte(s2[i]);
+   if Chr1 in [97..122] then Chr1 := Chr1 - 32;
+   if Chr2 in [97..122] then Chr2 := Chr2 - 32;
+   result := Chr1 - Chr2;
+   end ;
+if (result = 0) and (Count1 <> Count2) then begin
+   if Count1 > Count2 then result := byte(UpCase(s1[Count1 + 1]))
+   else result := -byte(UpCase(s2[Count2 + 1]));
+   end ;
 end ;
 
-function left(s: string;i:Longint): string;
+{==============================================================================}
+{   Ansi string functions                                                      }
+{   these functions rely on the character set loaded by the OS                 }
+{==============================================================================}
+
+type
+   TCaseTranslationTable = array[0..255] of char;
+
+var
+   UpperCaseTable: TCaseTranslationTable;
+   LowerCaseTable: TCaseTranslationTable;
+
+function AnsiUpperCase(const s: string): string;
 begin
-left := copy(s,1,i);
 end ;
 
-function right(s: string;i:Longint): string;
+function AnsiLowerCase(const s: string): string;
 begin
-right := copy(s,1 + length(s)-i,i);
 end ;
 
-function trim(s: string):string;
-var i,l:longint;
+function AnsiCompareStr(const S1, S2: string): integer;
 begin
-l := length(s);
-while (s[l] = ' ') and (l > 0) do dec(l);
-setLength(s, l);
-i := 1;
-while (s[i] = ' ') and (i <= l) do inc(i);
-trim := copy(s, i, l);
 end ;
 
-function trimleft(s:string):string;
-var i,l:longint;
+function AnsiCompareText(const S1, S2: string): integer;
+begin
+end ;
+
+function AnsiStrComp(S1, S2: PChar): integer;
+begin
+end ;
+
+function AnsiStrIComp(S1, S2: PChar): integer;
+begin
+end ;
+
+function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;
+begin
+end ;
+
+function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;
+begin
+end ;
+
+function AnsiStrLower(Str: PChar): PChar;
+begin
+end ;
+
+function AnsiStrUpper(Str: PChar): PChar;
+begin
+end ;
+
+function AnsiLastChar(const S: string): PChar;
+begin
+end ;
+
+function AnsiStrLastChar(Str: PChar): PChar;
+begin
+end ;
+
+{==============================================================================}
+{  End of Ansi functions                                                       }
+{==============================================================================}
+
+{   Trim returns a copy of S with blanks characters on the left and right stripped off   }
+
+function Trim(const S: string): string;
+var Ofs, Len: integer;
+begin
+len := Length(S);
+while (S[Len] = ' ') and (Len > 0) do
+   dec(Len);
+Ofs := 1;
+while (S[Ofs] = ' ') and (Ofs <= Len) do
+   Inc(Ofs);
+result := Copy(S, Ofs, 1 + Len - Ofs);
+end ;
+
+{   TrimLeft returns a copy of S with all blank characters on the left stripped off  }
+
+function TrimLeft(const S: string): string;
+var i,l:integer;
 begin
 l := length(s);
 i := 1;
 while (s[i] = ' ') and (i <= l) do inc(i);
-trimleft := copy(s, i, l);
+Result := copy(s, i, l);
 end ;
 
-function trimright(s:string):string;
-var l:longint;
+{   TrimRight returns a copy of S with all blank characters on the right stripped off  }
+
+function TrimRight(const S: string): string;
+var l:integer;
 begin
 l := length(s);
 while (s[l] = ' ') and (l > 0) do dec(l);
-setLength(s, l);
-trimright := s;
+result := copy(s,1,l);
 end ;
 
-{ Conversion stuff }
+{   QuotedStr returns S quoted left and right and every single quote in S
+    replaced by two quotes   }
 
-function  IntToStr(l:longint):string;
-var result:string;
+function QuotedStr(const S: string): string;
 begin
-system.str(l,result);
-inttostr := result;
+result := AnsiQuotedStr(s, '''');
 end ;
 
-function  StrToInt(s:string):longint;
-var result:longint;c:word;
+{   AnsiQuotedStr returns S quoted left and right by Quote,
+    and every single occurance of Quote replaced by two   }
+
+function AnsiQuotedStr(const S: string; Quote: char): string;
+var i, j, count: integer;
 begin
-val(s, result, c);
-strtoint := result;
+result := '' + Quote;
+count := length(s);
+i := 0;
+j := 0;
+while i < count do begin
+   i := i + 1;
+   if S[i] = Quote then begin
+      result := result + copy(S, 1 + j, i - j) + Quote;
+      j := i;
+      end ;
+   end ;
+if i <> j then
+   result := result + copy(S, 1 + j, i - j);
+result := result + Quote;
 end ;
 
-function  IntToHex(Value: longint; Digits: longint): string;
-var result:string;i:longint;
+{   AnsiExtractQuotedStr returns a copy of Src with quote characters
+    deleted to the left and right and double occurances
+    of Quote replaced by a single Quote   }
+
+function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
+var i: integer; P, Q: PChar;
 begin
-result := '        ';
-setLength(result, digits);
+P := Src;
+if Src^ = Quote then P := P + 1;
+Q := StrEnd(P);
+if PChar(Q - 1)^ = Quote then Q := Q - 1;
+SetLength(result, Q - P);
+i := 0;
+while P <> Q do begin
+   i := i + 1;
+   result[i] := P^;
+   if (P^ = Quote) and (PChar(P + 1)^ = Quote) then
+      P := P + 1;
+   P := P + 1;
+   end ;
+SetLength(result, i);
+end ;
+
+{   AdjustLineBreaks returns S with all CR characters not followed by LF
+    replaced with CR/LF  }
+//  under Linux all CR characters or CR/LF combinations should be replaced with LF
+
+function AdjustLineBreaks(const S: string): string;
+var i, j, count: integer;
+begin
+result := '';
+i := 0;
+j := 0;
+count := Length(S);
+while i < count do begin
+   i := i + 1;
+   if (S[i] = #13) and ((i = count) or (S[i + 1] <> #10)) then begin
+      result := result + Copy(S, 1 + j, i - j) + #10;
+      j := i;
+      end ;
+   end ;
+if j <> i then
+   result := result + copy(S, 1 + j, i - j);
+end ;
+
+{   IsValidIdent returns true if the first character of Ident is in:
+    'A' to 'Z', 'a' to 'z' or '_' and the following characters are
+    on of: 'A' to 'Z', 'a' to 'z', '0'..'9' or '_'    }
+
+function IsValidIdent(const Ident: string): boolean;
+var i, len: integer;
+begin
+result := false;
+len := length(Ident);
+if len <> 0 then begin
+   result := Ident[1] in ['A'..'Z', 'a'..'z', '_'];
+   i := 1;
+   while (result) and (i < len) do begin
+      i := i + 1;
+      result := result and (Ident[i] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
+      end ;
+   end ;
+end ;
+
+{   IntToStr returns a string representing the value of Value    }
+
+function IntToStr(Value: integer): string;
+begin
+System.Str(Value, result);
+end ;
+
+{   IntToHex returns a string representing the hexadecimal value of Value   }
+
+const
+   HexDigits: array[0..15] of char = '0123456789ABCDEF';
+
+function IntToHex(Value: integer; Digits: integer): string;
+var i: integer;
+begin
+SetLength(result, digits);
 for i := 0 to digits - 1 do begin
    result[digits - i] := HexDigits[value and 15];
    value := value shr 4;
    end ;
-inttohex := result;
 end ;
 
+{   StrToInt converts the string S to an integer value,
+    if S does not represent a valid integer value EConvertError is raised  }
+
+function StrToInt(const S: string): integer;
+var Error: word;
+begin
+Val(S, result, Error);
+// if Error <> 0 then raise EConvertError.create(s + ' is not a valid integer');
+end ;
+
+{   StrToIntDef converts the string S to an integer value,
+    Default is returned in case S does not represent a valid integer value  }
+
+function StrToIntDef(const S: string; Default: integer): integer;
+var Error: word;
+begin
+Val(S, result, Error);
+if Error <> 0 then result := Default;
+end ;
+
+{   LoadStr returns the string resource Ident.   }
+
+function LoadStr(Ident: integer): string;
+begin
+end ;
+
+{   FmtLoadStr returns the string resource Ident and formats it accordingly   }
+
+{
+function FmtLoadStr(Ident: integer; const Args: array of const): string;
+begin
+end ;
+}
+
+{==============================================================================}
+{   extra functions                                                            }
+{==============================================================================}
+
+{   SetLength sets the length of S to NewLength   }
+//  SetLength should be in the system unit
+//  which lacks the ShortString version of SetLength
+
+function SetLength(var S: string; NewLength: integer): integer;
+begin
+if (NewLength > 255) then
+   NewLength := 255;
+S[0] := char(NewLength);
+Result := Ord(S[0]);
+end ;
+
+{   LeftStr returns Count left-most characters from S   }
+
+function LeftStr(const S: string; Count: integer): string;
+begin
+result := Copy(S, 1, Count);
+end ;
+
+{    RightStr returns Count right-most characters from S   }
+
+function RightStr(const S: string; Count: integer): string;
+begin
+result := Copy(S, 1 + Length(S) - Count, Count);
+end ;
+
+{    BCDToInt converts the BCD value Value to an integer   }
+
+function BCDToInt(Value: integer): integer;
+var i, j: integer;
+begin
+result := 0;
+j := 1;
+for i := 0 to SizeOf(Value) shr 1 - 1 do begin
+   result := result + j * (Value and 15);
+   j := j * 10;
+   Value := Value shr 4;
+   end ;
+end ;
+
+{$IFDEF GO32V2}
+
+{  Codepage constants  }
+
+const
+   CP_US = 437;
+   CP_MultiLingual = 850;
+   CP_SlavicLatin2 = 852;
+   CP_Turkish = 857;
+   CP_Portugal = 860;
+   CP_IceLand = 861;
+   CP_Canada = 863;
+   CP_NorwayDenmark = 865;
+
+{  CountryInfo   }
+
+{$PACKRECORDS 1}
+type
+   TCountryInfo = record
+      InfoId: byte;
+      case integer of
+         1: ( Size: word;
+              CountryId: word;
+              CodePage: word;
+              CountryInfo: array[0..33] of byte );
+         2: ( UpperCaseTable: longint );
+         4: ( FilenameUpperCaseTable: longint );
+         5: ( FilecharacterTable: longint );
+         6: ( CollatingTable: longint );
+         7: ( DBCSLeadByteTable: longint );
+   end ;
+
+{$PACKRECORDS NORMAL}
+
+procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo);
+var Regs: Registers;
+begin
+Regs.AH := $65;
+Regs.AL := InfoId;
+Regs.BX := CodePage;
+Regs.DX := CountryId;
+Regs.ES := transfer_buffer shr 16;
+Regs.DI := transfer_buffer and 65535;
+Regs.CX := SizeOf(TCountryInfo);
+RealIntr($21, Regs);
+DosMemGet(transfer_buffer shr 16, transfer_buffer and 65535, CountryInfo, Regs.CX );
+end ;
+
+procedure InitAnsi;
+var CountryInfo: TCountryInfo;
+begin
+GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo);
+DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128);
+end ;
+
+{$ENDIF}
 
 {
   $Log$
-  Revision 1.1  1998-04-10 15:17:46  michael
+  Revision 1.2  1998-09-16 08:28:42  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+  Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
 
-}
+  27 April 1998:
+  Function: BCDToInt added
+}
+

rtl/objpas/sysstrh.inc

@@ -21,29 +21,72 @@
     System Utilities For Free Pascal
 }
 
-{ String functions }
+{==============================================================================}
+{   standard functions                                                         }
+{==============================================================================}
 
-function  setLength(var s: string; newLength: longint): longint;
-function  UpperCase(s: string): string;
-function  LowerCase(s: string): string;
-function  AnsiUpperCase(s: string): string;
-function  AnsiLowerCase(s: string): string;
-function  Left(s: string; i: longint): string;
-function  Right(s: string; i: longint): string;
-function  Trim(s: string): string;
-function  TrimLeft(s: string): string;
-function  TrimRight(s: string): string;
+type
+   PString = ^String;
 
-{ Conversion Functions }
+function NewStr(const S: string): PString;
+procedure DisposeStr(S: PString);
+procedure AssignStr(var P: PString; const S: string);
+procedure AppendStr(var Dest: PString; const S: string);
+function UpperCase(const s: string): string;
+function LowerCase(const s: string): string;
+function CompareStr(const S1, S2: string): Integer;
+function CompareMem(P1, P2: Pointer; Length: cardinal): integer;
+function CompareText(const S1, S2: string): integer;
 
-function  IntToStr(l:longint):string;
-function  StrToInt(s:string):longint;
-function  IntToHex(Value: longint; Digits: longint): string;
+function AnsiUpperCase(const s: string): string;
+function AnsiLowerCase(const s: string): string;
+function AnsiCompareStr(const S1, S2: string): integer;
+function AnsiCompareText(const S1, S2: string): integer;
+function AnsiStrComp(S1, S2: PChar): integer;
+function AnsiStrIComp(S1, S2: PChar): integer;
+function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;
+function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;
+function AnsiStrLower(Str: PChar): PChar;
+function AnsiStrUpper(Str: PChar): PChar;
+function AnsiLastChar(const S: string): PChar;
+function AnsiStrLastChar(Str: PChar): PChar;
+
+function Trim(const S: string): string;
+function TrimLeft(const S: string): string;
+function TrimRight(const S: string): string;
+function QuotedStr(const S: string): string;
+function AnsiQuotedStr(const S: string; Quote: char): string;
+function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
+function AdjustLineBreaks(const S: string): string;
+function IsValidIdent(const Ident: string): boolean;
+function IntToStr(Value: integer): string;
+// function IntToStr(Value: Int64): string;
+function IntToHex(Value: integer; Digits: integer): string;
+// function IntToHex(Value: Int64; Digits: integer): string;
+function StrToInt(const s: string): integer;
+// function StrToInt64(const s: string): int64;
+function StrToIntDef(const S: string; Default: integer): integer;
+// function StrToInt64Def(const S: string; Default: int64): int64;
+function LoadStr(Ident: integer): string;
+// function FmtLoadStr(Ident: integer; const Args: array of const): string;
+
+{==============================================================================}
+{   extra functions                                                            }
+{==============================================================================}
+
+function SetLength(var S: string; NewLength: integer): integer; // should be in the system unit
+function LeftStr(const S: string; Count: integer): string;
+function RightStr(const S: string; Count: integer): string;
+function BCDToInt(Value: integer): integer;
 
 {
   $Log$
-  Revision 1.1  1998-04-10 15:17:46  michael
+  Revision 1.2  1998-09-16 08:28:43  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+  Revision 1.1  1998/04/10 15:17:46  michael
   + Initial implementation; Donated by Gertjan Schouten
     His file was split into several files, to keep it a little bit structured.
 
 }
+

rtl/objpas/sysutils.pp

@@ -20,7 +20,12 @@ interface
 {$endif}
 
     uses
-       dos,objpas; { should become platform independent }
+    {$ifdef linux}
+       linux,
+    {$else}
+       dos,
+    {$endif}
+       objpas; { should become platform independent }
 
 
     type
@@ -127,7 +132,10 @@ end.
 
 {
     $Log$
-    Revision 1.5  1998-09-04 08:49:07  peter
+    Revision 1.6  1998-09-16 08:28:44  michael
+    Update from gertjan Schouten, plus small fix for linux
+
+    Revision 1.5  1998/09/04 08:49:07  peter
       * 0.99.5 doesn't compile a whole objpas anymore to overcome crashes
 
     Revision 1.4  1998/08/10 15:52:27  peter