Unit MiscSubs;

{***************************************************************************}

{* SORTED BY TYPE:

{*   DATA [FILE, NUMERICAL, TEXT];

{*   I/O  [CRT, FILE, ERROR, USER];

{*   SORT [TEXT, NUMERICAL]

{*   SEARCH

{*   PROGRAM.

{*

{* SplitFileName      DATA      FILE

{* DiceRoll           DATA      NUM    int

{* HexToDec           DATA      Num    LongInt     Hex to Decimal

{* Factorial          DATA      NUM

{* Hex                DATA      Num    String

{* JulianTime         DATA      NUM

{* Quad               DATA      NUM    byte; identifies the quadrant 1 to 4

{* Stats              DATA      NUM

{* TimeDiff           DATA      NUM

{* TimeInSecs         DATA      NUM    time from MS-DOS

{* TimeSecs           DATA      NUM    longint

{* TimeSecSplit       DATA      NUM

{* DateTimeStr           DATA      TEXT   string

{* DropLeadBlanks     DATA      TEXT

{* GetQuote           DATA      TEXT

{* IntStr             DATA      TEXT

{* MultiChar          DATA      TEXT

{* ParseInt           DATA      TEXT

{* PosChars           DATA      TEXT

{* PosString          DATA      TEXT

{* StrByte            DATA      TEXT

{* StrInt             DATA      TEXT

{* StrIntLen          DATA      TEXT

{* StrIntSig          DATA      TEXT   string; with + or - sign

{* StrIntZer          DATA      TEXT        STRING

{* StrLongInt         DATA      TEXT

{* StrReal            DATA      TEXT

{* StrWrdZer          DATA      TEXT

{* UpCaseFirstLetters DATA      TEXT    string

{* UpCaseStr          DATA      TEXT

{* ValChar            DATA      TEXT

{* ValInt             DATA      TEXT

{* ValReal            DATA      TEXT

{* IOCumOK            I/O       ERROR   ANDs IOResult with previous

{* IOError            I/O       ERROR

{* IOGood             I/O       ERROR

{* SortSIT            SORT      TEXT

{* DoSubProg          PROGRAM

{*

{***************************************************************************}

Interface

{***************************************************************************}

{***************************************************************************}

const

  CroftUnitConstant = 100;



type

  CroftUnitRealArrayType = array[1..CroftUnitConstant] of real;

  CroftUnitStringArrayType = array[1..CroftUnitConstant] of string;



Function  DateTimeStr: string;

Function  DecToHex(Dec: longint): string;

Function  DiceRoll(Mul, Die, Bas: integer): integer;

Procedure DoSubProg(SubProg: string);

procedure DropLeadBlanks(var InStr: string);

function  Factorial(InInt: integer; InFactorial: integer): boolean;

procedure GetQuote(var QuoteStr: string);

Function  HexToDec(Hex: string): longint;

Function  IntStr(InStr: string): integer;

Procedure IOCumOK(var PrevAndNewStatus: boolean);

Function  IOError: byte;

Function  IOGood: boolean;

Function  JulianDate: longint;

Function  LongIntStr(InStr: string): longint;

function  MultiChar(RepeatChar: char; NumTimes: integer): string;

Procedure ParseInt(InStr:string; var Position: integer; var IntOut: integer);

procedure PosChars(SearchChars: string; InStr: string; var Position: integer;

            var CharFound: char);

procedure PosString(SearchStr, InStr: string; var Position: integer);

Function  Quad(X, Y: longint): byte;

procedure SortSIT(var TextArray: CroftUnitStringArrayType;

            LineCount, Position, Width: integer);

procedure Stats(NumArray: CroftUnitRealArrayType; Count: integer;

            var Mean, Median, StanDev, MinValue, MaxValue: real);

Function  StrByte(InByte: byte): string;

function  StrInt(NumInt: integer): string;

function  StrIntLen(NumInt: integer; IntLen: integer): string;

function  StrIntSig(NumInt: longint; IntLen: byte): string;

Function  StrIntZer(NumIn: integer; NumLen: integer): string;

function  StrReal(Number: real; Width, Decimals: integer): string;

Function  StrLongInt(NumInt: longint): string;

Function  StrWrdZer(NumWrd: word; WrdLen: integer): string;

Function  TimeDiff(JulianDay, NumSecs: longint): longint;

Function  TimeInSecs: real;

Function  TimeSecs(Day, Hour, Min, Secs: longint): longint;

Procedure TimeSecSplit(NumSecs: longint;

            var Days, Hours, Minutes, Seconds: longint);

Function  UpCaseFirstLetters(InStr: string): string;

function  UpCaseStr(InStr: string): string;

function  ValChar(CharVal: char): integer;

function  ValInt(StrVal: string): integer;

function  ValReal(StrVal: string): real;

function  WildCardFormat(FormatStr: string; InStr: string): boolean;



Implementation

{***************************************************************************}

{***************************************************************************}

uses

  Crt,

  Dos,

  FileIO,

  Globals,

  Graph,

  IOPorts, {* fix this! for BBS's ErrSayL *}

  Keyboard;



Function DateTimeStr: string;

{***************************************************************************}

var

  Year,

  Month,

  Day,

  DayOfWeek,

  Hour,

  Minute,

  Second,

  Sec100: word;

  MonthStr,

  DayOfWeekStr: string;

begin

  GetDate(Year, Month, Day, DayOfWeek);

  GetTime(Hour, Minute, Second, Sec100);

  case Month of

    1:  MonthStr := 'January';

    2:  MonthStr := 'February';

    3:  MonthStr := 'March';

    4:  MonthStr := 'April';

    5:  MonthStr := 'May';

    6:  MonthStr := 'June';

    7:  MonthStr := 'July';

    8:  MonthStr := 'August';

    9:  MonthStr := 'September';

    10:  MonthStr := 'October';

    11:  MonthStr := 'November';

    12:  MonthStr := 'December';

  end; {case}

  case DayOfWeek of

    0:  DayOfWeekStr := 'Sunday';

    1:  DayOfWeekStr := 'Monday';

    2:  DayOfWeekStr := 'Tuesday';

    3:  DayOfWeekStr := 'Wednesday';

    4:  DayOfWeekStr := 'Thursday';

    5:  DayOfWeekStr := 'Friday';

    6:  DayOfWeekStr := 'Saturday';

  end; {case}

  DateTimeStr := StrIntZer(Year, 4) + ' ' +

              MonthStr + ' ' +

              StrIntZer(Day,2) + ' ' +

              DayOfWeekStr + ' ' +

              StrIntZer(Hour, 2) + ':' +

              StrIntZer(Minute, 2) + ':' +

              StrIntZer(Second, 2) + '.' +

              StrIntZer(Sec100, 2);

end;



Function DecToHex(Dec: longint): string;

{***************************************************************************}

var

  H: array[1..4] of integer;

  HH: array[1..4] of string[1];

  alpha: integer;

begin

  if Dec > (16*16*16*16) then

    begin

      writeln('Overflow in Function Hex!');

      halt;

    end;

  H[4] := (Dec Mod (16*16*16*16)) div (16*16*16);

  H[3] := (Dec Mod (16*16*16)) div (16*16);

  H[2] := (Dec Mod (16*16)) div 16;

  H[1] := Dec Mod 16;

  for alpha := 1 to 4 do

    case H[alpha] of

      10:  HH[alpha] := 'A';

      11:  HH[alpha] := 'B';

      12:  HH[alpha] := 'C';

      13:  HH[alpha] := 'D';

      14:  HH[alpha] := 'E';

      15:  HH[alpha] := 'F';

      else

        str(H[alpha],HH[alpha]);

    end; {case}

  DecToHex := HH[4] + HH[3] + HH[2] + HH[1];

end;



Function  DiceRoll(Mul, Die, Bas: integer): integer;

{***************************************************************************}

var

  alpha,

  subtotal: integer;

begin

  randomize;

  subtotal := 0;

  for alpha := 1 to Mul do

    subtotal := subtotal + random(Die) +1;

  DiceRoll := subtotal + Bas;

end;



Procedure DoSubProg(SubProg: string);

{***************************************************************************}

begin

  SwapVectors;

  Exec(SubProg,'');

  SwapVectors;

  if DosError <> 0 then

    begin

      writeln('DosError = ',DosError,'!');

      writeln('Press ENTER to continue...');

      readln;

    end;

end;



procedure DropLeadBlanks(var InStr: string);

{***************************************************************************}

begin

  while Pos(' ',InStr) = 1 do

    InStr := copy(InStr, 2, length(InStr) - 1);

end;



function Factorial(InInt: integer; InFactorial: integer): boolean;

{***************************************************************************}

var

  TempReal1,

  TempReal2: real;

  TempFactorial: boolean;

begin

  TempReal1 := InInt/InFactorial;

  TempReal2 := int(InInt/InFactorial);

  if TempReal1 = TempReal2 then

    TempFactorial := true

  else

    TempFactorial := false;

  Factorial := TempFactorial;

end;



procedure GetQuote(var QuoteStr: string);

{***************************************************************************}

{* Gets a string between two quotes (").  If there is no second quote,

{* will report all of the string left after the first quote.

{***************************************************************************}

var

  FirstQuotePos,

  NextQuotePos: integer;

begin

  FirstQuotePos := Pos('"', QuoteStr);

  NextQuotePos := Pos('"',

    copy(QuoteStr, FirstQuotePos + 1, length(QuoteStr) - FirstQuotePos));

  if NextQuotePos = 0 then

    NextQuotePos := length(QuoteStr) + 1;

  QuoteStr := copy(QuoteStr, FirstQuotePos+1, NextQuotePos -1);

end;



Function HexToDec(Hex: string): longint;

{***************************************************************************}

var

  NewHex: array[1..255] of char;

  HexStr: string;

  TempDec: longint;

  alpha, bravo: integer;

  Place: longint;

  dumint: integer;

  added:  longint;

  TempAdded: longint;

begin

  HexStr := '';

  for alpha := 1 to length(Hex) do

    begin

      if not (Hex[alpha] in ['0'..'9','A'..'F','a'..'f']) then

        NewHex[alpha] := #0

      else

        NewHex[alpha] := Hex[alpha];

      if NewHex[alpha] <> #0 then

        HexStr := HexStr + NewHex[alpha];

    end;

  TempDec := 0;

  for alpha := length(HexStr) downto 1 do

    begin

      Place := 1;

      for bravo := (length(HexStr) - alpha +1) downto 2 do

        Place := Place * $10;

      case HexStr[alpha] of

        'A','a':  TempDec := TempDec + 10*Place;

        'B','b':  TempDec := TempDec + 11*Place;

        'C','c':  TempDec := TempDec + 12*Place;

        'D','d':  TempDec := TempDec + 13*Place;

        'E','e':  TempDec := TempDec + 14*Place;

        'F','f':  TempDec := TempDec + 15*Place;

        else

          begin

            val(HexStr[alpha], Added, DumInt);

            TempAdded := Added*Place;

            TempDec := TempDec + TempAdded;

          end;

      end; {case}

    end;

  HexToDec := TempDec;

end;



Function IntStr(InStr: string): integer;

{***************************************************************************}

var

  TempIntStr: integer;

begin

  val(InStr, TempIntStr, DumInt);

  IntStr := TempIntStr;

end;



Procedure IOCumOK(var PrevAndNewStatus: boolean);

{***************************************************************************}

begin

  if IOResult <> 0 then

    PrevAndNewStatus := false;

end;



function IOError: byte;

{***************************************************************************}

var

   Code : byte;

   Msg  : string[50];

begin

   Code := ioresult;

   if Code = 0 then

      begin

        IOError := Code;

        exit

      end;

   case Code of

        2: Msg := 'no such filename in directory';

        3: Msg := 'no such directory path';

        4: Msg := 'too many files opened simultaneously';

        5: Msg := 'file access denied for intended operation';

        6: Msg := 'unrecognized file handle';

       12: Msg := 'attempted file access with wrong filemode';

       15: Msg := 'invalid drive number used in getdir';

       16: Msg := 'directory cannot be removed by rmdir';

       17: Msg := 'drives specified by rename cannot differ';

      100: Msg := 'attempted read past end of file';

      101: Msg := 'disk data area is full';

      102: Msg := 'cannot attempt I/O without assigning file';

      103: Msg := 'file not prepared with reset or rewrite';

      104: Msg := 'file not prepared to be read from';

      105: Msg := 'file not prepared to be written to';

      106: Msg := 'illegal numeric format in data';

      150: Msg := 'attempt to read write-protected disk';

      151: Msg := 'unit is unknown';

      152: Msg := 'disk drive is not ready';

      153: Msg := 'command is unknown';

      154: Msg := 'error in cyclical redundancy check';

      155: Msg := 'invalid drive request structure length';

      156: Msg := 'seek error on disk';

      157: Msg := 'media type is unknown';

      158: Msg := 'disk sector not found';

      159: Msg := 'printer is out of paper';

      160: Msg := 'write fault on I/O device';

      161: Msg := 'read fault on I/O device';

      162: Msg := 'general hardware failure'

   else

           Msg := 'unknown I/O error type'

   end;

   ErrSayL('** I/O error encountered.');

   ErrSayL('** error code = '+ StrInt(Code));

   ErrSayL('** '+ Msg);

   IOError := Code

end;



Function IOGood: boolean;

{***************************************************************************}

var

  TestIO: integer;

begin

  TestIO := IOResult;

  if TestIO <> 0 then

    begin

      IOGood := false;

      writeln('Input/Output Error #',TestIO,'!');

      Wait;

    end

  else

    IOGood := true;

end;



Function JulianDate: longint;

{***************************************************************************}

{* p. 528 TP Programmer's Toolkit

{***************************************************************************}

var

  Temp: longint;

  Year, Month, Day: word;

begin

  GetDate(Year, Month, Day, DumWord);

  if Year < 100 then

    Year := Year + 1900;

  Temp := (Month-14) div 12;

  JulianDate := Day - 32075 +

    (1461*(Year+4800+Temp) div 4) +

    (367*(Month-2-Temp*12) div 12) -

    (3*((Year+4900+Temp) div 100) div 4);

end;



Function  LongIntStr(InStr: string): longint;

{***************************************************************************}

var

  IntVal: longint;

begin

  val(InStr, IntVal, DumInt);

  LongIntStr := IntVal;

end;



function MultiChar(RepeatChar: char; NumTimes: integer): string;

{***************************************************************************}

var

  TempMultiChar: string;

  alpha: integer;

begin

  TempMultiChar := '';

  for alpha := 1 to NumTimes do

    TempMultiChar := TempMultiChar + RepeatChar;

  MultiChar := TempMultiChar;

end;



Procedure ParseInt(InStr:string; var Position: integer; var IntOut: integer);

{***************************************************************************}

{*  Changes Position to one after the last int value char.

{*  If not integer is found, changes Position to one > string length.

{*  Only gets the first int value it sees.

{*  Ignores leading space characters and non-numerical characters.

{*  Stops on first non-numerical character.

{*  Returns value of zero if no integer found.

{*  Gets absolute value of negative numbers (does not recognize "-").

{***************************************************************************}

var

  NumStr: string;

  LenInStr: integer;

  alpha: integer;

  NewPosition: integer;

begin

  NumStr := '';

  ;

  LenInStr := length(InStr);

  for alpha := Position to LenInStr do

    begin

      NewPosition := alpha + 1;

      if InStr[alpha] in ['0'..'9'] then

        NumStr := NumStr + InStr[alpha]

      else

        if NumStr <> '' then

          begin

            NewPosition := alpha;

            alpha := LenInStr;

          end;

    end;

  if NumStr <> '' then

    IntOut := ValInt(NumStr)

  else

    IntOut := 0;

  Position := NewPosition;

end;



procedure PosChars(SearchChars: string; InStr: string; var Position: integer;

  var CharFound: char);

{***************************************************************************}

{* Position is where it starts looking and where it stops.

{* Returns first character found and its position.

{* If no character found, then Position is one > length InStr and

{*   CharFound = #0;

{***************************************************************************}

var

  LenInStr,

  LenSearchChars: integer;

  alpha,

  bravo: integer;

  NewPosition: integer;

begin

  LenInStr := length(InStr);

  LenSearchChars := length(SearchChars);

  ;

  CharFound := #0;

  ;

  for alpha := Position to LenInStr do

    begin

      for bravo := 1 to LenSearchChars do

        begin

          if InStr[alpha] = SearchChars[bravo] then

            begin

              CharFound := SearchChars[bravo];

              bravo := LenSearchChars;

              NewPosition := alpha;

              alpha := LenInStr;

            end

          else

            NewPosition := alpha + 1;

        end;

    end;

  Position := NewPosition;

end;



procedure PosString(SearchStr, InStr: string; var Position: integer);

{***************************************************************************}

{* Position is the start search location and the position where found.

{* If not found, Position set to length of InStr + 1.

{***************************************************************************}

var

  PositionSave,

  LenInStrSave: integer;

begin

  PositionSave := Position;

  LenInStrSave := length(InStr);

  InStr := copy(InStr, Position, length(InStr) - Position);

  Position := Pos(SearchStr, InStr);

  if Position = 0 then

    Position := LenInStrSave + 1

  else

    Position := Position + PositionSave - 1;

end;



Function Quad(X, Y: longint): byte;

{***************************************************************************}

begin

  if X < 0 then

    begin

      if Y < 0 then

        Quad := 3

      else

        Quad := 4;

    end

  else

    begin

      if Y < 0 then

        Quad := 2

      else

        Quad := 1;

    end;

end;



procedure Skip;

{***************************************************************************}

begin

  write(#7);

  writeln('An unwritten area of code has been skipped.');

end;



procedure SortSIT(var TextArray: CroftUnitStringArrayType;

  LineCount, Position, Width: integer);

{***************************************************************************}

{* page 240 Turbo Pascal Programmer's Toolkit

{***************************************************************************}

var

  J,

  K: integer;

  ThisLine: string;

begin

  if LineCount <=1 then

    exit;

  for J := 2 to LineCount do

    begin

      ThisLine := TextArray[J];

      K := J - 1;

      while (Copy(ThisLine, Position, Width) <

        Copy(TextArray[K], Position, Width)) and (K > 0) do

          begin

            TextArray[K + 1] := TextArray[K];

            K := K - 1;

          end;

      TextArray[K + 1] := ThisLine;

    end;

end;



procedure Stats(NumArray: CroftUnitRealArrayType; Count: integer;

  var Mean, Median, StanDev, MinValue, MaxValue: real);

{***************************************************************************}

{* Page 404 of Turbo Pascal Programmer's Toolkit by Rugg & Feldman

{* Limited by CroftUnitConstant

{***************************************************************************}

var

  J,

  K,

  Mid: integer;

  Temp: real;

  ValueSum,

  SquareSum: real;

begin

  Mean := 0;

  Median := 0;

  StanDev := 0;

  MinValue := 0;

  MaxValue := 0;

  ;

  if Count < 1 then

    exit;

  for J := 2 to Count do

    begin

      Temp := NumArray[J];

      K := J- 1;

      while (Temp < NumArray[K]) and (K > 0) do

        begin

          NumArray[K+1] := NumArray[K];

          dec(K);

        end;

      NumArray[K+1] := Temp;

    end;

  ValueSum := 0.0;

  SquareSum := 0.0;

  for J := 1 to Count do

    begin

      ValueSum := ValueSum + NumArray[J];

      SquareSum := SquareSum + sqr(NumArray[J]);

    end;

  MinValue := NumArray[1];

  MaxValue := NumArray[Count];

  if odd(Count) then

    Median := NumArray[(Count+1) div 2]

  else

    begin

      Mid := Count div 2;

      Median := (NumArray[Mid] + NumArray[Mid+1])/2.0;

    end;

  Mean := ValueSum / Count;

  if Count = 1 then

    StanDev := 0.0

  else

    StanDev := sqrt((SquareSum - Count * Mean * Mean) / (Count - 1));

end;



Function StrByte(InByte: byte): string;

{***************************************************************************}

var

  OutStr: string;

begin

  Str(InByte, OutStr);

  StrByte := OutStr;

end;



function  StrInt(NumInt: integer): string;

{***************************************************************************}

var

  TempStr: string;

begin

  Str(NumInt, TempStr);

  StrInt := TempStr;

end;



function  StrIntLen(NumInt: integer; IntLen: integer): string;

{***************************************************************************}

var

  TempStr: string;

begin

  Str(NumInt, TempStr);

  while length(TempStr) < IntLen do

    TempStr := ' ' + TempStr;

  StrIntLen := TempStr;

end;



function  StrIntSig(NumInt: longint; IntLen: byte): string;

{***************************************************************************}

var

  Temp: string;

begin

  Temp := StrIntZer(Abs(NumInt), IntLen - 1);

  if NumInt < 0 then

    Temp := '-' + Temp

  else

    Temp := '+' + Temp;

  StrIntSig := Temp;

end;



Function StrIntZer(NumIn: integer; NumLen: integer): string;

{***************************************************************************}

var

  TempStr: string;

begin

  if NumIn >= 0 then

    begin

      Str(NumIn, TempStr);

      while length(TempStr) < NumLen do

        TempStr := '0' + TempStr;

      StrIntZer := TempStr;

    end

  else

    begin

      Str(-NumIn, TempStr);

      while length(TempStr) < NumLen do

        TempStr := '0' + TempStr;

      StrIntZer := '-' + TempStr;

    end;

end;



function StrReal(Number: real; Width, Decimals: integer): string;

{***************************************************************************}

var

  TempStr: string;

begin

  Str(Number:Width:Decimals, TempStr);

  StrReal := TempStr;

end;



Function  StrLongInt(NumInt: longint): string;

{***************************************************************************}

var

  TempStr: string;

begin

  str(NumInt, TempStr);

  StrLongInt := TempStr;

end;



Function  StrWrdZer(NumWrd: word; WrdLen: integer): string;

{***************************************************************************}

var

  TempStr: string;

begin

  Str(NumWrd, TempStr);

  while length(TempStr) < WrdLen do

    TempStr := '0' + TempStr;

  StrWrdZer := TempStr;

end;



Function TimeDiff(JulianDay, NumSecs: longint): longint;

{***************************************************************************}

begin

  TimeDiff := (JulianDay*24*3600+ NumSecs)

    - (JulianDate*24*3600+ trunc(TimeInSecs));

end;



Function TimeInSecs: real;

{***************************************************************************}

var

  Hour, Min, Sec, Sec100: word;

  HourL, MinL, SecL, Sec100L: real;

begin

  GetTime(Hour, Min, Sec, Sec100);

  HourL := Hour;

  MinL := Min;

  SecL := Sec;

  Sec100L := Sec100;

  TimeInSecs := HourL*3600 + MinL*60 + SecL + Sec100L/100;

end;



Function  TimeSecs(Day, Hour, Min, Secs: longint): longint;

{***************************************************************************}

var

  Temp: longint;

begin

  Temp := Secs;

  Temp := Temp + Min*60;

  Temp := Temp + Hour*3600;

  Temp := Temp + Day*86400;

  TimeSecs := Temp;

end;



Procedure TimeSecSplit(NumSecs: longint;

            var Days, Hours, Minutes, Seconds: longint);

{***************************************************************************}

begin

  Days := NumSecs div 86400;

  Hours := (NumSecs mod 86400) div 3600;

  Minutes := ((NumSecs mod 86400) mod 3600) div 60;

  Seconds := ((NumSecs mod 86400) mod 3600) mod 60;

end;



Function  UpCaseFirstLetters(InStr: string): string;

{***************************************************************************}

var

  alpha: integer;

  OutStr: string;

  First: boolean;

  Letter: char;

begin

  First := true;

  OutStr := '';

  for alpha := 1 to length(InStr) do

    begin

      Letter := InStr[alpha];

      if (Letter <> ' ') and First then

        begin

          Letter := UpCase(Letter);

          First := false;

        end;

      if Letter = ' ' then

        First := true;

      OutStr := OutStr + Letter;

    end;

  UpCaseFirstLetters := OutStr;

end;



function UpCaseStr(InStr: string): string;

{***************************************************************************}

var

  alpha: integer;

begin

  for alpha := 1 to length(InStr) do

    InStr[alpha] := UpCase(InStr[alpha]);

  UpCaseStr := InStr;

end;



function  ValChar(CharVal: char): integer;

{***************************************************************************}

var

  TempValue: integer;

begin

  Val(CharVal, TempValue, DumInt);

  ValChar := TempValue;

end;



function ValInt(StrVal: string): integer;

{***************************************************************************}

var

  TempValue: integer;

begin

  Val(StrVal, TempValue, DumInt);

  ValInt := TempValue;

end;



function ValReal(StrVal: string): real;

{***************************************************************************}

var

  TempValue: real;

begin

  Val(StrVal, TempValue, DumInt);

  ValReal := TempValue;

end;



function WildCardFormat(FormatStr: string; InStr: string): boolean;

{***************************************************************************}

var

  Position,

  bravo: integer;

  TempWildCardFormat: boolean;

  LeadStr,

  ExtStr: string;

  LenFormatStr,

  LenInStr: integer;

begin

  FormatStr := UpCaseStr(FormatStr);

  InStr := UpCaseStr(InStr);

  LenFormatStr := length(FormatStr);

  Position := 1;

  LeadStr := '';

  while (FormatStr[Position] <> '*') and (Position <= LenFormatStr)

    and (FormatStr[Position] <> '.') do

      begin

        LeadStr := LeadStr + FormatStr[Position];

        Inc(Position);

      end;

  ExtStr := '';

  repeat

    Inc(Position);

  until (FormatStr[Position] = '.') or (Position >= LenFormatStr);

  Inc(Position);

  while (FormatStr[Position] <> '*') and (Position <= LenFormatStr) do

    begin

      ExtStr := ExtStr + FormatStr[Position];

      Inc(Position);

    end;

  TempWildCardFormat := true;

  for Position := 1 to length(LeadStr) do

    begin

      if InStr[Position] <> LeadStr[Position] then

        TempWildCardFormat := false;

    end;

  LenInStr := length(InStr);

  Position := 0;

  repeat

    Inc(Position);

    if Position = 10 then

      TempWildCardFormat := false;

  until (InStr[Position] = '.') or (Position >= LenInStr);

  for bravo := 1 to length(ExtStr) do

    begin

      if InStr[Position+bravo] <> ExtStr[bravo] then

        TempWildCardFormat := false;

    end;

  WildCardFormat := TempWildCardFormat;

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

end.