[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    Unit MKString32; {Delphi32 Only!}

    ///////////////////////////////////////////////////////////////////////////////
    // MKString32 Coded in Part by G.E. Ozz Nixon Jr. of www.warpgroup.com       //
    // ========================================================================= //
    // Original Source for DOS by Mythical Kindom's Mark May (mmay@dnaco.net)    //
    // Re-written and distributed with permission!                               //
    // See Original Copyright Notice before using any of this code!              //
    // Many new commands have beed added, and we have optimized the code to use  //
    // Windows API calls when applicable, along with support for french days     //
    // And we merged all the stray MK* units into this string unit!              //
    ///////////////////////////////////////////////////////////////////////////////

    Interface

    Uses
       Windows, {api calls!}
       SysUtils,
       Crc32;

    Type
       DateTime=Record
          Year,
          Month,
          Day,
          DOW,
          Hour,
          Min,
          Sec,
          Sec100:Word;
       End;

       MKDateTime=Record
          Year,
          Month,
          Day,
          Hour,
          Min,
          Sec:Word;
       End;

       MKDateType=Record
          Year,
          Month,
          Day:Word;
       End;

    Function  LoCase(Ch: Char): Char;
    Function  padright(st:string;ch:char;l:integer):string;
    Function  PadLeft(St:String;Ch:Char;L:Integer): String;
    function  striplead(st:string;ch:char):string;
    Function  StripTrail(St:String;Ch:Char):String;
    Function  StripBoth(St:String;Ch:Char):String;
    Function  Upper(St:String):String;
    Function  Lower(St:String):String;
    Function  Proper(St:String):String;
    Function  WWrap(St:String;Max:Integer;var LeftOver:String):String;
    function  ExtractWord(Str : String; N : Integer) : String;
    Function  WordCount(Str : String) : Integer;
    Function  CommaStr(Const Number:LongInt):String;
    Function  Long2Str(Const Number:LongInt):String;
    Function  Bin2Str(Number: Byte): String;
    Function  Str2Bin(St: String): Byte;
    Function  Str2Long(St: String): LongInt;
    Function  Long2Hex(Const Number:LongInt):String;
    Function  Word2Hex(Const Number:Word):String;
    Function  Byte2Hex(Const Number:Byte):String;
    Function  Hex2Byte(Const Str:String):Byte;
    Function  Hex2Word(Const Str:String):Word;
    Function  Hex2Long(Const Str:String):Longint;
    Function  DateStr(DosDate: LongInt): String;
    Function  TimeStr(DosDate: LongInt): String;
    Procedure AddBackSlash(Var InPath: String);
    Function  WithBackSlash(InPath: String): String;
    Function  FormattedDate(DT: DateTime; Mask: String;French:boolean): String;
    Function  FormattedDosDate(DosDate: LongInt; Mask:String;French:boolean): String;
    Function  DOWStr(Dow:Word;French:Boolean):String;
    Function  DOWShortStr(DOW:Word;French:Boolean):String;
    Function  ReformatDate(ODate: String; Mask: String;French:Boolean): String;
    Function  LongDate(DStr: String): LongInt;
    Function  TimeStr2Word(TS: String): Word;
    Function  Word2TimeStr(CTime: Word): String;
    Function  MonthStr(MonthNo:Word;French:Boolean):String;
    Function  PChar2Str(Str:PChar):String; {Convert asciiz to string}
    Function  Str2PChar(Str:String):PChar; {Convert string to asciiz}
    Function  MKDateToStr(MKD: String): String; {Convert YYMMDD to MM-DD-YY}
    Function  StrToMKDate(Str: String): String; {Convert MM-DD-YY to YYMMDD}
    Function  CleanChar(InChar: Char): Char;
    Function  CleanStr(Str:String):String;
    Function  IsNumeric(Str: String): Boolean;
    Function  PosLastChar(Ch: Char; St: String): Word;
    Function  Min(Const A,B:Longint):Longint;
    Function  Max(Const A,B:Longint):Longint;
    Function  Str2Real(Str:string):real;
    function  Real2Str(Number:real;Decimals:byte):string;
    Procedure SetLFlag(Var L: LongInt; Bit: Byte; Setting: Boolean);
    Function  GetLFlag(L: LongInt; Bit: Byte): Boolean;
    Procedure SetWFlag(Var L: Word; Bit: Byte; Setting: Boolean);
    Function  GetWFlag(L: Word; Bit: Byte): Boolean;
    Procedure SetBFlag(Var L: Byte; Bit: Byte; Setting: Boolean);
    Function  GetBFlag(L: Byte; Bit: Byte): Boolean;
    Function  StrCRC(Str: String): LongInt;
    Function  NameCRC(Str: String): LongInt;
    Procedure UpdateWordFlag(Var Flag: Word; Mask: Word; Setting: Boolean);
    Function  DTToUnixDate(DT: DateTime): LongInt;
    Procedure UnixToDt(SecsPast: LongInt; Var DT: DateTime);
    Function  GregorianToJulian(DT: DateTime): LongInt;
    Function  ValidDate(DT: DateTime): Boolean;
    Function  ToUnixDate(FDate: LongInt): LongInt;
    Function  ToUnixDateStr(FDate: LongInt): String;
    Function  FromUnixDateStr(S: String): LongInt;
    Procedure JulianToGregorian(JulianDN : LongInt; Var Year, Month,
      Day : Integer);
    Function  DaysAgo(DStr: String): LongInt;
    Function  Flag2Str(Number: Byte): String;
    Function  Str2Flag(St: String): Byte;
    Function  ValidMKDate(DT: MKDateTime): Boolean;
    Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
    Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
    Procedure Str2MKD(St: String; Var MKD: MKDateType);
    Function  MKD2Str(MKD: MKDateType): String;
    Function  GetDosDate: LongInt;
    Function  GetDOW: Word;
    Function  GetResultCode: Integer;
    Function  TimeOut(Time:DWord):Boolean;
    Function  CurrentTimerTick:DWord;

    Const
       CommaChar:Char=',';
       DecodeHEXTable='123456789ABCEDF';
       EncodeHEXTable='0'+DecodeHEXTable;

    Implementation

    Const
       C1970 = 2440588;
       D0 =    1461;
       D1 =  146097;
       D2 = 1721119;

    function Real2Str(Number:real;Decimals:byte):string;
    var Temp : string;
    begin
        Str(Number:20:Decimals,Temp);
        repeat
           If copy(Temp,1,1)=' ' then delete(Temp,1,1);
        until copy(temp,1,1)<>' ';
        If Decimals=255 {Floating} then begin
           While Temp[1]='0' do Delete(Temp,1,1);
           If Temp[Length(temp)]='.' then Delete(temp,Length(temp),1);
        end;
        Result:= Temp;
    end;

    Function Str2Real(Str:string):real;
    var
      code : integer;
      Temp : real;
    begin
        If length(Str)=0 then Result:=0
        else begin
           If Copy(Str,1,1)='.' Then Str:='0'+Str;
           If (Copy(Str,1,1)='-') and (Copy(Str,2,1)='.') Then Insert('0',Str,2);
           If Str[length(Str)]='.' then Delete(Str,length(Str),1);
           val(Str,temp,code);
           if code=0 then Result:=temp
           else Result:=0;
        end;
    end;

    Function Min(Const A,B:Longint):Longint; {min}
    Begin
       If A<B then Result:=A
       Else Result:=B;
    End;

    Function Max(Const A,B:Longint):Longint;  {max}
    Begin
       If A>B then Result:=A
       Else Result:=B;
    End;

    Function LoCase(Ch:Char):Char;
    Begin
       Result:=Char(CharLower(PChar(Ch))); {WIN32API}
    End;

    Procedure AddBackSlash(Var InPath: String);
    Begin
      If Length(InPath) > 0 Then Begin
        If InPath[Length(InPath)] <> '\' Then InPath:=InPath+'\';
      End;
    End;

    Function WithBackSlash(InPath:String):String;
    Begin
       AddBackSlash(InPath);
       Result:=InPath;
    End;

    Function Bin2Str(Number: Byte): String;
      Var
        Temp2: Byte;
        i: Word;
        TempStr: String[8];

      Begin
      Temp2 := $80;
      For i := 1 to 8 Do
        Begin
        If (Number and Temp2) <> 0 Then
          TempStr[i] := '1'
        Else
          TempStr[i] := '0';
        Temp2 := Temp2 shr 1;
        End;
      TempStr[0] := #8;
      Bin2Str := TempStr;
      End;

    Function Str2Bin(St: String): Byte;
      Var
        i: Word;
        Temp1: Byte;
        Temp2: Byte;

      Begin
      St := StripBoth(St,' ');
      St := PadLeft(St,'0',8);
      Temp1 := 0;
      Temp2 := $80;
      For i := 1 to 8 Do
        Begin
        If St[i] = '1' Then
          Inc(Temp1,Temp2);
        Temp2 := Temp2 shr 1;
        End;
      Str2Bin := Temp1;
      End;

    Function Str2Long(St:String):LongInt;
    Var
       Err:Integer;
       Temp:LongInt;

    Begin
       St:=StripBoth(St,' ');
       If Length(St)=0 then Result:=0
       Else Begin
          Val(St,Temp,Err);
          If Err=0 Then Result:=Temp
          Else Result:=0;
       End;
    End;

    Function DateStr(DosDate:LongInt):String;
    Var
       W1,W2,W3:Word;

    Begin
       DecodeDate(FileDateToDateTime(DosDate),W3,W1,W2);
       Result:=PadLeft(Long2Str(W1),' ',2)+'-'+
                PadLeft(Long2Str(W2),' ',2)+'-'+
                PadLeft(Copy(Long2Str(W3),3,2),' ',2);
    End;

    Function TimeStr(DosDate:LongInt):String;
    Var
       W1,W2,W3,W4:Word;

    Begin
       DecodeTime(FileDateToDateTime(DosDate),W1,W2,W3,W4);
       Result:=PadLeft(Long2Str(W1),' ',2)+':'+
                PadLeft(Long2Str(W2),' ',2)+':'+
                PadLeft(Long2Str(W3),' ',2);
    End;

    Function Byte2Hex(Const Number:Byte):String;
    Begin
       Result:=EncodeHEXTable[(Number shr 4)+1]+
          EncodeHEXTable[(Number And $F)+1];
    End;

    Function Word2Hex(Const Number:Word):String;
    Begin
       Result:=Byte2Hex(Number Shr 8)+Byte2Hex(Number And $FF);
    End;

    Function Long2Hex(Const Number:LongInt):String;
    Type
       WordRec=Record
          Lo:Word;
          Hi:Word;
       End;

    Begin
       Result:=Word2Hex(WordRec(Number).Hi)+Word2Hex(WordRec(Number).Lo);
    End;

    Function Hex2Byte(Const Str:String):Byte;
    Begin
       Result:=Str2Long('H'+Str);
    End;

    Function Hex2Word(Const Str:String):Word;
    Begin
       Result:=Str2Long('H'+Str);
    End;

    Function Hex2Long(Const Str:String):LongInt;
    Begin
       Result:=Str2Long('H'+Str);
    End;

    Function Long2Str(Const Number:LongInt):String;
    Var
       TempStr:String;

    Begin
      Str(Number,TempStr);
      Result:=TempStr;
    End;

    Function CommaStr(Const Number:LongInt):String;
    Var
       StrPos:Byte;
       NumberStr:String;

    Begin
       NumberStr:=Long2Str(Number);
       StrPos:=Length(NumberStr)-2;
       While StrPos>1 Do Begin
          Insert(CommaChar,NumberStr,StrPos);
          StrPos:=StrPos-3;
       End;
       Result:=NumberStr;
    End;

    Function wordcount(str:string):integer;
    var
       count : integer;
       i : integer;
       len : integer;

    begin
      len := length(str);
      count := 0;
      i := 1;
      while i <= len do
        begin
        while ((i <= len) and ((str[i] = #32) or (str[i] = #9) or (Str[i] = ';'))) do
          inc(i);
        if i <= len then
          inc(count);
        while ((i <= len) and ((str[i] <> #32) and (str[i] <> #9) and (Str[i] <> ';'))) do
          inc(i);
        end;
      wordcount := count;
      end;

    function extractword(str : string; n : integer) : string;
      Var
        count : integer;
        i : integer;
        len : integer;
        done : boolean;
        retstr : string;

      Begin
      retstr := '';
      len := length(str);
      count := 0;
      i := 1;
      done := false;
      While (i <= len) and (not done) do
        Begin
        While ((i <= len) and ((str[i] = #32) or (str[i] = #9) or (Str[i] = ';'))) do
          inc(i);
        if i <= len then
          inc(count);
        if count = n then
          begin
          retstr:='';
          If (i > 1) Then
            If Str[i-1] = ';' Then
              RetStr := ';';
          while ((i <= len) and ((str[i] <> #32) and (str[i] <> #9) and (Str[i] <> ';'))) do
            begin
            retstr:=RetStr+str[i];
            inc(i);
            end;
          done := true;
          end
        Else
          while ((i <= len) and ((str[i] <> #32) and (str[i] <> #9) and (Str[i] <> ';'))) do
            inc(i);
        End;
      extractword := retstr;
      End;

    Function WWrap(St:String; Max:Integer;var leftOver:String):String;
      Var
        TempStr: String;
        TempPos: Integer;

      Begin
      LeftOver:='';
      TempStr := St;
      If Length(TempStr) > Max Then Begin
        TempPos := Max;
        While ((TempStr[TempPos]<>' ') And (TempPos>(Max-20))
          And (TempPos>1)) Do
          Dec(TempPos);
        If (Length(TempStr)>TempPos) Then
          LeftOver:=Copy(TempStr,TempPos + 1,Length(TempStr) - TempPos);
        TempStr:=Copy(TempStr,1,TempPos);
      End;
      Result:=TempStr;
    End;

    Function Proper(St:String):String;
    Var
       TempStr:String;
       i:Integer;
       NextUp:Boolean;

    Begin
       TempStr:=St;
       i:=1;
       NextUp:=True;
       TempStr:=St;
       While i<=Length(TempStr) Do Begin
          If Not (TempStr[i] in ['A'..'Z','a'..'z']) then NextUp:=True
          Else Begin
             If NextUp Then Begin
                NextUp:=False;
                TempStr[i]:=UpCase(TempStr[i]);
             End
             Else TempStr[i] := LoCase(TempStr[i]);
          End;
          Inc(I);
       End;
       Result:=TempStr;
    End;

    Function PadLeft(St:String;Ch:Char;L:Integer): String;
    Var
       TempStr:String;
       I:Integer;

    Begin
       I:=Length(St);
       If I>=L Then Result:=Copy(St,1,L)
       Else Begin
          Setlength(TempStr,L);
          FillChar(TempStr[I+1],L-I,Ch);
          Move(St[1],TempStr[1],I);
          Result:=TempStr;
       End;
    End;

    Function padright(st:string;ch:char;l:integer):string;
    Var
       TempStr:String;
       I:Integer;

    Begin
       I:=Length(St);
       If I>=L Then Result:=Copy(St,1,L)
       Else Begin
          Setlength(TempStr,L);
          FillChar(TempStr[1],L-I,Ch);
          Move(St[1],TempStr[(L-I)+1],I);
          Result:=TempStr;
       End;
    end;

    Function Upper(St:String):String;
    Begin
       Result:=AnsiUppercase(St);
    End;

    Function Lower(St:String):String;
    Begin
       Result:=AnsiLowercase(St);
    End;

    function striplead(st:string;ch:char):string;
    var
       Tempstr:string;

    begin
       Tempstr:=st;
       While ((TempStr[1]=Ch) and (Length(TempStr)>0)) do
          Delete(TempStr,1,1);
       Result:=TempStr;
    end;

    Function StripTrail(St:String;Ch:Char):String;
    Var
       TempStr:String;

    Begin
       TempStr:=St;
       While ((TempStr[Length(TempStr)]=Ch) and (Length(TempStr)>0)) do
          Delete(TempStr,Length(TempStr),1);
       Result:=TempStr;
    End;

    Function StripBoth(St:String;Ch:Char):String;
    Begin
       Result:=StripTrail(StripLead(St,Ch),Ch);
    End;

    Function FormattedDate(DT:DateTime;Mask:String;French:Boolean):String;
      Var
        DStr: String[2];
        MStr: String[2];
        MNStr: String[3];
        YStr: String[4];
        HourStr: String[2];
        MinStr: String[2];
        SecStr: String[2];
        TmpStr: String;
        CurrPos: Word;
        i: Word;

      Begin
      TmpStr := Mask;
      Mask := Upper(Mask);
      DStr := Copy(PadLeft(Long2Str(Dt.Day),'0',2),1,2);
      MStr := Copy(PadLeft(Long2Str(Dt.Month),'0',2),1,2);
      YStr := Copy(PadLeft(Long2Str(Dt.Year),'0',4),1,4);
      HourStr := Copy(PadLeft(Long2Str(Dt.Hour),' ', 2),1,2);
      MinStr := Copy(PadLeft(Long2Str(Dt.Min), '0',2),1,2);
      SecStr := Copy(PadLeft(Long2Str(Dt.Sec), '0',2),1,2);
      MNStr := MonthStr(Dt.Month,French);
      If (Pos('YYYY', Mask) = 0) Then
        YStr := Copy(YStr,3,2);
      CurrPos := Pos('DD', Mask);
      If CurrPos > 0 Then
        For i := 1 to Length(DStr) Do
          TmpStr[CurrPos + i - 1] := DStr[i];
      CurrPos := Pos('YY', Mask);
      If CurrPos > 0 Then
        For i := 1 to Length(YStr) Do
          TmpStr[CurrPos + i - 1] := YStr[i];
      CurrPos := Pos('MM', Mask);
      If CurrPos > 0 Then
        For i := 1 to Length(MStr) Do
          TmpStr[CurrPos + i - 1] := MStr[i];
      CurrPos := Pos('HH', Mask);
      If CurrPos > 0 Then
        For i := 1 to Length(HourStr) Do
          TmpStr[CurrPos + i - 1] := HourStr[i];
      CurrPos := Pos('SS', Mask);
      If CurrPos > 0 Then
        For i := 1 to Length(SecStr) Do
          TmpStr[CurrPos + i - 1] := SecStr[i];
      CurrPos := Pos('II', Mask);
      If CurrPos > 0 Then
        For i := 1 to Length(MinStr) Do
          TmpStr[CurrPos + i - 1] := MinStr[i];
      CurrPos := Pos('NNN', Mask);
      If CurrPos > 0 Then
        For i := 1 to Length(MNStr) Do
          TmpStr[CurrPos + i - 1] := MNStr[i];
      FormattedDate := TmpStr;
      End;

    Function FormattedDosDate(DosDate: LongInt; Mask:String;French:Boolean): String;
    Var
       DT:DateTime;

    Begin
       DecodeDate(FileDateToDateTime(DosDate),DT.Year,DT.Month,DT.Year);
       DecodeTime(FileDateToDateTime(DosDate),DT.Hour,DT.Min,DT.Sec,DT.Sec100);
       FormattedDosDate:=FormattedDate(DT, Mask,French);
    End;

    Function DOWStr(Dow:Word;French:Boolean):String;
    Begin
       If French then Begin
       Case DOW Of
          0:Result:='Dimanche';
          1:Result:='Lundi';
          2:Result:='Mardi';
          3:Result:='Mercredi';
          4:Result:='Jeudi';
          5:Result:='Vendredi';
          6:Result:='Samedi';
       Else Result:='?????';
       End;
       End
       Else Begin
       Case DOW Of
          0:Result:='Sunday';
          1:Result:='Monday';
          2:Result:='Tuesday';
          3:Result:='Wednesday';
          4:Result:='Thursday';
          5:Result:='Friday';
          6:Result:='Saturday';
       Else Result:='?????';
       End;
       End;
    End;

    Function DOWShortStr(DOW:Word;French:Boolean):String;
    Begin
       Result:=Copy(DOWStr(Dow,French),1,3);
    End;

    Function ReformatDate(ODate: String; Mask: String;French:Boolean): String;
    Var
       DT: DateTime;

    Begin
       DT.Year:=Str2Long(Copy(ODate,7,2));
       DT.Month:=Str2Long(Copy(ODate,1,2));
       DT.Day:=Str2Long(Copy(ODate,4,2));
       If DT.Year < 80 Then Inc(DT.Year,2000)
       Else Inc(DT.Year,1900);
       Result:=FormattedDate(DT,Mask,French);
    End;

    Function Word2TimeStr(CTime: Word): String;
    Begin
       Result:=PadLeft(Long2Str(Hi(CTime)),'0',2)+':'+
           PadLeft(Long2Str(Lo(CTime)),'0',2);
    End;

    Function TimeStr2Word(TS: String):Word;
    Begin
       Result:=Str2Long(Copy(TS,4,2))+(Str2Long(Copy(TS,1,2)) shl 8);
    End;

    Function MonthStr(MonthNo:Word;French:Boolean):String;
    Begin
       Case MonthNo of
          01:Result:='Jan';
          02:Result:='Feb';
          03:Result:='Mar';
          04:If French then Result:='Avr'
             Else Result:='Apr';
          05:If French then Result:= 'Mai'
             Else Result:='May';
          06:Result:='Jun';
          07:Result:='Jul';
          08:If French then Result:='Auo'
             Else Result:='Aug';
          09:Result:='Sep';
          10:Result:='Oct';
          11:Result:='Nov';
          12:Result:='Dec';
          Else Result := '???';
       End;
    End;

    Function PChar2Str(Str:PChar):String; {Convert asciiz to string}
    Begin
       Result:=Strpas(Str);
    End;

    Function Str2PChar(Str:String):PChar; {Convert string to asciiz}
    Begin
       Result:=PChar(Str);
    End;

    Function MKDateToStr(MKD: String): String; {Convert YYMMDD to MM-DD-YY}
      Begin
      MKDateToStr := Copy(MKD,3,2) + '-' + Copy(MKD,5,2) + '-' +
        Copy(MKD,1,2);
      End;

    Function StrToMKDate(Str: String): String; {Convert MM-DD-YY to YYMMDD}
    Begin
       StrToMKDate:=Copy(Str,7,2)+Copy(Str,1,2)+Copy(Str,4,2);
    End;

    Function CleanChar(InChar:Char):Char;
    Const
        CtlChars:String[32]='oooooooooXoollo><|!Pg*|^v><-^v';
        HiChars1:String[64]='CueaaaageeeiiiAAEaaooouuyOUcLYPfarounNao?--//!<>***|||||||||||||';
        HiChars2:String[64]='|--|-+||||=+|=++-=--==-||||*****abcnEduto0nd80En=+><fj/~oo.vn2* ';

    Begin
       Case InChar of
          #0..#31:CleanChar:=CtlChars[Ord(InChar)+1];
          #128..#191:CleanChar:=HiChars1[Ord(InChar)-127];
          #192..#255:CleanChar:=HiChars2[Ord(InChar)-191];
       Else
          CleanChar:=InChar;
       End;
    End;

    Function CleanStr(Str:String):String;
    Var
       I:Integer;

    Begin
       I:=1;
       While (I<=Length(Str)) do Begin
          Str[I]:=CleanChar(Str[I]);
          Inc(I);
       End;
       Result:=Str;
    End;

    Function IsNumeric(Str:String):Boolean;
    Var
       I:Integer;

    Begin
       I:=1;
       While (I<=Length(Str)) do Begin
          If Not (Str[i] in ['0'..'9']) Then Begin
             Result:=False;
             Exit;
          End;
          Inc(I);
       End;
       Result:=True;
    End;

    Function LongDate(DStr:String):LongInt;
    Var
       DT: DateTime;
       DosDate: TDateTime;

    Begin
       DT.Year:=Str2Long(Copy(DStr,7,2));
       If Dt.Year<80 Then Inc(DT.Year,2000)
       Else Inc(DT.Year,1900);
       DT.Month:=Str2Long(Copy(DStr,1,2));
       DT.Day:=Str2Long(Copy(DStr,4,2));
       DT.Hour:=0;
       DT.Min:=0;
       DT.Sec:=0;
       DosDate:=EncodeDate(DT.Year,DT.Month,DT.Day);
       LongDate:=DateTimeToFileDate(DosDate);
    End;

    Function PosLastChar(Ch:Char;St:String):Word;
    Var
       I:Integer;

    Begin
       I:=Length(St);
       While ((i>0) and (st[i]<>ch)) Do Dec(i);
       Result:=I;
    End;

    Function DaysAgo(DStr: String): LongInt;
    Var
        ODate: DateTime;
        CDate: DateTime;

      Begin
      DecodeDate(Now,CDate.Year,CDate.Month,CDate.Day);
      CDate.Hour := 0;
      CDate.Min := 0;
      CDate.Sec := 0;
      ODate.Year := Str2Long(Copy(DStr,7,2));
      If ODate.Year < 80 Then
        Inc(ODate.Year, 2000)
      Else
        Inc(ODate.Year, 1900);
      ODate.Month := Str2Long(Copy(DStr,1,2));
      ODate.Day := Str2Long(Copy(DStr, 4, 2));
      ODate.Hour := 0;
      ODate.Min := 0;
      ODate.Sec := 0;
      DaysAgo := GregorianToJulian(CDate) - GregorianToJulian(ODate);
      End;

    Function NameCRC(Str: String): LongInt;
      Var
        L: LongInt;

      Begin
      L := StrCrc(Str);
      If ((L >= 0) and (L < 16)) Then
        Inc(L,16);
      NameCrc := L;
      End;

    Function StrCRC(Str: String): LongInt;
      Var
        Crc: LongInt;
        i: Word;

      Begin
      i := 1;
      Crc := $ffffffff;
      While i <= Length(Str) Do
        Begin
        Crc := UpdC32(Ord(UpCase(Str[i])),Crc);
        Inc(i);
        End;
      StrCrc := Crc;
      End;

    Procedure SetLFlag(Var L: LongInt; Bit: Byte; Setting: Boolean);
      Var
        Mask: LongInt;

      Begin
      Mask := 1;
      Mask := Mask Shl (Bit - 1);
      If Setting Then
        L := L or Mask
      Else
        L := (L and (Not Mask));
      End;

    Function GetLFlag(L: LongInt; Bit: Byte): Boolean;
      Var
        Mask: LongInt;

      Begin
      Mask := 1;
      Mask := Mask Shl (Bit - 1);
      If (L and Mask) = 0 Then
        GetLFlag := False
      Else
        GetLFlag := True;
      End;

    Procedure SetWFlag(Var L: Word; Bit: Byte; Setting: Boolean);
      Var
        Mask: Word;

      Begin
      Mask := 1;
      Mask := Mask Shl (Bit - 1);
      If Setting Then
        L := L or Mask
      Else
        L := (L and (Not Mask));
      End;

    Function GetWFlag(L: Word; Bit: Byte): Boolean;
      Var
        Mask: Word;

      Begin
      Mask := 1;
      Mask := Mask Shl (Bit - 1);
      If (L and Mask) = 0 Then
        GetWFlag := False
      Else
        GetWFlag := True;
      End;

    Procedure SetBFlag(Var L: Byte; Bit: Byte; Setting: Boolean);
      Var
        Mask: Byte;

      Begin
      Mask := 1;
      Mask := Mask Shl (Bit - 1);
      If Setting Then
        L := L or Mask
      Else
        L := (L and (Not Mask));
      End;

    Function GetBFlag(L: Byte; Bit: Byte): Boolean;
      Var
        Mask: Byte;

      Begin
      Mask := 1;
      Mask := Mask Shl (Bit - 1);
      If (L and Mask) = 0 Then
        GetBFlag := False
      Else
        GetBFlag := True;
      End;

    Function GregorianToJulian(DT: DateTime): LongInt;
    Var
      Century: LongInt;
      XYear: LongInt;
      Month: LongInt;

      Begin
      Month := DT.Month;
      If Month <= 2 Then
        Begin
        Dec(DT.Year);
        Inc(Month,12);
        End;
      Dec(Month,3);
      Century := DT.Year Div 100;
      XYear := DT.Year Mod 100;
      Century := (Century * D1) shr 2;
      XYear := (XYear * D0) shr 2;
      GregorianToJulian :=  ((((Month * 153) + 2) div 5) + DT.Day) + D2
        + XYear + Century;
      End;

    Procedure JulianToGregorian(JulianDN : LongInt; Var Year, Month,
      Day : Integer);

      Var
        Temp,
        XYear: LongInt;
        YYear,
        YMonth,
        YDay: Integer;

      Begin
      Temp := (((JulianDN - D2) shl 2) - 1);
      XYear := (Temp Mod D1) or 3;
      JulianDN := Temp Div D1;
      YYear := (XYear Div D0);
      Temp := ((((XYear mod D0) + 4) shr 2) * 5) - 3;
      YMonth := Temp Div 153;
      If YMonth >= 10 Then
        Begin
        YYear := YYear + 1;
        YMonth := YMonth - 12;
        End;
      YMonth := YMonth + 3;
      YDay := Temp Mod 153;
      YDay := (YDay + 5) Div 5;
      Year := YYear + (JulianDN * 100);
      Month := YMonth;
      Day := YDay;
      End;

    Procedure UnixToDt(SecsPast: LongInt; Var Dt: DateTime);
    Var
      DateNum: LongInt;
      Year,Month,Day:Integer;

    Begin
      Datenum := (SecsPast Div 86400) + c1970;
      Year:=DT.Year;
      Month:=DT.Month;
      Day:=DT.Day;
      JulianToGregorian(DateNum,Year,Month,Day);
      DT.Year:=Year;
      DT.Month:=Month;
      DT.Day:=Day;
      SecsPast := SecsPast Mod 86400;
      DT.Hour := SecsPast Div 3600;
      SecsPast := SecsPast Mod 3600;
      DT.Min := SecsPast Div 60;
      DT.Sec := SecsPast Mod 60;
      End;

    Function DTToUnixDate(DT: DateTime): LongInt;
       Var
         SecsPast, DaysPast: LongInt;

      Begin
      DaysPast := GregorianToJulian(DT) - c1970;
      SecsPast := DaysPast * 86400;
      SecsPast := SecsPast + (LongInt(DT.Hour) * 3600) + (DT.Min * 60) + (DT.Sec);
      DTToUnixDate := SecsPast;
      End;

    Function ToUnixDate(FDate: LongInt): LongInt;
      Var
          DT: DateTime;

      Begin
      DecodeDate(FileDateToDateTime(FDate),DT.Year,DT.Month,DT.Day);
      DecodeTime(FileDateToDateTime(FDate),DT.Hour,DT.Min,DT.Sec,DT.Sec100);
      ToUnixDate := DTToUnixDate(Dt);
      End;

    Function ToUnixDateStr(FDate: LongInt): String;
      Var
      SecsPast: LongInt;
      S: String;

      Begin
      SecsPast := ToUnixDate(FDate);
      S := '';
      While (SecsPast <> 0) And (Length(s) < 255) DO
        Begin
        s := Chr((secspast And 7) + $30) + s;
        secspast := (secspast Shr 3)
        End;
      s := '0' + s;
      ToUnixDateStr := S;
      End;

    Function FromUnixDateStr(S: String): LongInt;
      Var
        DT: DateTime;
        secspast, datenum: LONGINT;
        n: WORD;
        Year,Month,Day:Integer;

      Begin
      SecsPast := 0;
      For n := 1 To Length(s) Do
        SecsPast := (SecsPast shl 3) + Ord(s[n]) - $30;
      Datenum := (SecsPast Div 86400) + c1970;
      Year:=DT.Year;
      Month:=DT.Month;
      Day:=DT.Day;
      JulianToGregorian(DateNum, Year,Month,day);
      DT.Year:=Year;
      DT.Month:=Month;
      DT.Day:=Day;
      SecsPast := SecsPast Mod 86400;
      DT.Hour := SecsPast Div 3600;
      SecsPast := SecsPast Mod 3600;
      DT.Min := SecsPast Div 60;
      DT.Sec := SecsPast Mod 60;
      FromUnixDateStr := DateTimeToFileDate(StrToDateTime(PadLeft(Long2Str(DT.Month),' ',2)+'/'+
         PadLeft(Long2Str(DT.Day),' ',2)+'/'+PadLeft(Copy(Long2Str(DT.Year),3,2),' ',2)+' '+
         PadLeft(Long2Str(DT.Hour),' ',2)+':'+PadLeft(Long2Str(DT.Min),' ',2)+':'+
         PadLeft(Long2Str(DT.Sec),' ',2)));
      End;

    Function ValidDate(DT: DateTime): Boolean;
      Const
        DOM: Array[1..12] of Byte = (31,29,31,30,31,30,31,31,30,31,30,31);

      Var
        Valid: Boolean;

      Begin
      Valid := True;
      If ((DT.Month < 1) Or (DT.Month > 12)) Then
        Valid := False;
      If Valid Then
        If ((DT.Day < 1) Or (DT.Day > DOM[DT.Month])) Then
          Valid := False;
      If ((Valid) And (DT.Month = 2) And (DT.Day = 29)) Then
        If ((DT.Year Mod 4) <> 0) Then
          Valid := False;
      ValidDate := Valid;
      End;

    Procedure UpdateWordFlag(Var Flag: Word; Mask: Word; Setting: Boolean);
      Begin
      If Setting Then
        Flag := Flag or Mask
      Else
        Flag := Flag and (Not Mask);
      End;

    Function Flag2Str(Number: Byte): String;
      Var
        Temp2: Byte;
        i: Word;
        TempStr: String[8];

      Begin
      Temp2 := $01;
      For i := 1 to 8 Do Begin
        If (Number and Temp2) <> 0 Then TempStr[i] := 'X'
        Else TempStr[i] := '-';
        Temp2 := Temp2 shl 1;
      End;
      TempStr[0] := #8;
      Flag2Str := TempStr;
      End;

    Function Str2Flag(St: String): Byte;
      Var
        i: Word;
        Temp1: Byte;
        Temp2: Byte;

      Begin
      St := StripBoth(St,' ');
      St := PadLeft(St,'-',8);
      Temp1 := 0;
      Temp2 := $01;
      For i := 1 to 8 Do Begin
        If Uppercase(Copy(St,i,1)) = 'X' Then Inc(Temp1,Temp2);
        Temp2 := Temp2 shl 1;
      End;
      Str2Flag := Temp1;
      End;

    Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
      Begin
      DT2.Year := DT.Year;
      DT2.Month := DT.Month;
      DT2.Day := DT.Day;
      DT2.Hour := DT.Hour;
      DT2.Min := DT.Min;
      DT2.Sec := DT.Sec;
      End;

    Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
      Begin
      DT2.Year := DT.Year;
      DT2.Month := DT.Month;
      DT2.Day := DT.Day;
      DT2.Hour := DT.Hour;
      DT2.Min := DT.Min;
      DT2.Sec := DT.Sec;
      End;

    Function  ValidMKDate(DT: MKDateTime): Boolean;
      Var
        DT2: DateTime;

      Begin
      MKDT2DT(DT, DT2);
      ValidMKDate := ValidDate(DT2);
      End;

    Procedure Str2MKD(St: String; Var MKD: MKDateType);
      Begin
      FillChar(MKD, SizeOf(MKD), #0);
      MKD.Year := Str2Long(Copy(St, 7, 2));
      MKD.Month := Str2Long(Copy(St, 1, 2));
      MKD.Day := Str2Long(Copy(St, 4, 2));
      If MKD.Year < 80 Then
        Inc(MKD.Year, 2000)
      Else
        Inc(MKD.Year, 1900);
      End;

    Function MKD2Str(MKD: MKDateType): String;
      Begin
      MKD2Str := PadLeft(Long2Str(MKD.Month),'0',2) + '-' +
                 PadLeft(Long2Str(MKD.Day), '0',2) + '-' +
                 PadLeft(Long2Str(MKD.Year Mod 100), '0', 2);
      End;

    Function CurrentTimerTick:DWord;      {use this to use Timeout!}
    Begin
       CurrentTimerTick:=GetTickCount;
    End;

    Function TimeOut(Time:DWord):Boolean;
    Begin
      TimeOut:=Time-GetTickCount<0;
    End;

    Function GetResultCode: Integer;
    Begin
       GetResultCode:=0; {expand on this later!}
    End;

    Function GetDosDate: LongInt;
    Begin
       GetDosDate:=DateTimeToFileDate(Now);
    End;

    Function GetDOW: Word;
    Begin
       GetDOW:=DayOfWeek(Now);
    End;

    End.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]