[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]