This commit is contained in:
mysticbbs 2013-03-19 01:46:10 -04:00
parent 8462572104
commit 2ea12e38dc
3 changed files with 63 additions and 22 deletions

View File

@ -27,9 +27,10 @@ Unit m_CRC;
Interface Interface
Function Crc16 (CP: Byte; CRC: Word) : Word; Function Crc16 (CP: Byte; CRC: Word) : Word;
Function Crc32 (Octet: Byte; CRC: LongInt) : LongInt; Function Crc32 (Octet: Byte; CRC: LongInt) : LongInt;
Function FileCRC32 (FileName: String) : LongInt; Function FileCRC32 (FileName: String) : LongInt;
Function StringCRC32 (Str: String) : LongInt;
Implementation Implementation
@ -115,6 +116,16 @@ Begin
Crc32 := LongInt(CRC_32_TAB[Byte(CRC xor LongInt(Octet))] xor ((CRC shr 8) and $00FFFFFF)); Crc32 := LongInt(CRC_32_TAB[Byte(CRC xor LongInt(Octet))] xor ((CRC shr 8) and $00FFFFFF));
End; End;
Function StringCRC32 (Str: String) : LongInt;
Var
Count : Byte;
Begin
Result := $FFFFFFFF;
For Count := 1 to Length(Str) Do
Result := CRC32(Byte(Str[Count]), Result);
End;
Function FileCRC32 (FileName: String) : LongInt; Function FileCRC32 (FileName: String) : LongInt;
Var Var
InFile : File; InFile : File;

View File

@ -22,7 +22,7 @@ Function DateStr2Julian (Str: String) : LongInt;
Procedure DateG2J (Year, Month, Day: LongInt; Var Julian: LongInt); Procedure DateG2J (Year, Month, Day: LongInt; Var Julian: LongInt);
Procedure DateJ2G (Julian: LongInt; Var Year, Month, Day: SmallInt); Procedure DateJ2G (Julian: LongInt; Var Year, Month, Day: SmallInt);
Function DateValid (Str: String) : Boolean; Function DateValid (Str: String) : Boolean;
Function TimeDos2Str (Date: LongInt; Twelve: Boolean) : String; Function TimeDos2Str (Date: LongInt; Mode: Byte) : String;
Function DayOfWeek (Date: LongInt) : Byte; Function DayOfWeek (Date: LongInt) : Byte;
Function DaysAgo (Date: LongInt; dType: Byte) : LongInt; Function DaysAgo (Date: LongInt; dType: Byte) : LongInt;
Function TimeSecToStr (Secs: LongInt) : String; Function TimeSecToStr (Secs: LongInt) : String;
@ -274,24 +274,25 @@ Begin
Result := (M > 0) and (M < 13) and (D > 0) and (D < 32); Result := (M > 0) and (M < 13) and (D > 0) and (D < 32);
End; End;
Function TimeDos2Str (Date: LongInt; Twelve: Boolean) : String; Function TimeDos2Str (Date: LongInt; Mode: Byte) : String;
Var Var
DT : DateTime; DT : DateTime;
Begin Begin
UnPackTime (Date, DT); UnPackTime (Date, DT);
If Twelve Then Begin Case Mode of
If DT.Hour > 11 Then Begin 0 : Result := strZero(DT.Hour) + ':' + strZero(DT.Min);
If DT.Hour = 12 Then Inc(DT.Hour, 12); 1 : If DT.Hour > 11 Then Begin
If DT.Hour = 12 Then Inc(DT.Hour, 12);
Result := strZero(DT.Hour - 12) + ':' + strZero(DT.Min) + 'p' Result := strZero(DT.Hour - 12) + ':' + strZero(DT.Min) + 'p'
End Else Begin End Else Begin
If DT.Hour = 0 Then Inc(DT.Hour, 12); If DT.Hour = 0 Then Inc(DT.Hour, 12);
Result := strZero(DT.Hour) + ':' + strZero(DT.Min) + 'a'; Result := strZero(DT.Hour) + ':' + strZero(DT.Min) + 'a';
End; End;
End Else 2 : Result := strZero(DT.Hour) + ':' + strZero(DT.Min) + ':' + strZero(DT.Sec);
Result := strZero(DT.Hour) + ':' + strZero(DT.Min); End;
End; End;
Function DayOfWeek (Date: LongInt) : Byte; Function DayOfWeek (Date: LongInt) : Byte;

View File

@ -36,6 +36,7 @@ Function DirExists (Str: String) : Boolean;
Function DirSlash (Str: String) : String; Function DirSlash (Str: String) : String;
Function DirChange (Dir: String) : Boolean; Function DirChange (Dir: String) : Boolean;
Procedure DirClean (Path: String; Exempt: String); Procedure DirClean (Path: String; Exempt: String);
Function DirFiles (Str: String) : LongInt;
Function FileRename (OldFN, NewFN: String) : Boolean; Function FileRename (OldFN, NewFN: String) : Boolean;
Function FileCopy (Source, Target: String) : Boolean; Function FileCopy (Source, Target: String) : Boolean;
Function FileFind (FN: String) : String; Function FileFind (FN: String) : String;
@ -111,6 +112,9 @@ Type
Implementation Implementation
Uses Uses
{$IFDEF WINDOWS} // FileErase (FPC Erase) hardly EVER FUCKING WORKS.
Windows,
{$ENDIF}
DOS, DOS,
m_Types, m_Types,
m_Strings, m_Strings,
@ -129,13 +133,13 @@ Begin
ioCode := 5; ioCode := 5;
While (Count < ioRetries) and (ioCode = 5) Do Begin While (Count < ioRetries) and (ioCode = 5) Do Begin
Reset (F, RecSize); {$I-} Reset (F, RecSize); {$I+}
ioCode := IoResult; ioCode := IoResult;
Inc (Count); Inc (Count);
If ioCode = 5 Then WaitMS(ioWaitTime); If ioCode = 5 Then WaitMS(ioWaitTime);
End; End;
ioReset := (ioCode = 0); Result := (ioCode = 0);
End; End;
Function ioReWrite (Var F: File; RecSize: Word; Mode: Byte) : Boolean; Function ioReWrite (Var F: File; RecSize: Word; Mode: Byte) : Boolean;
@ -405,18 +409,25 @@ Begin
End; End;
End; End;
{$IFDEF WINDOWS}
Function FileErase (Str: String) : Boolean;
Begin
Str := Str + #0;
Result := Windows.DeleteFile(PChar(@Str[1]));
End;
{$ELSE}
Function FileErase (Str: String) : Boolean; Function FileErase (Str: String) : Boolean;
Var Var
F : File; F : File;
Begin Begin
Assign (F, Str); {$I-}
SetFAttr (F, Archive);
{$I-} Erase (F); {$I+} Assign (F, Str);
Erase (F);
Result := (IoResult = 0); Result := IoResult = 0;
End; End;
{$ENDIF}
Function FileExist (Str: String) : Boolean; Function FileExist (Str: String) : Boolean;
Var Var
DF : File; DF : File;
@ -760,4 +771,22 @@ Begin
FindClose(Dir); FindClose(Dir);
End; End;
Function DirFiles (Str: String) : LongInt;
Var
DirInfo : SearchRec;
Begin
Result := 0;
FindFirst (Str + '*', AnyFile, DirInfo);
While DosError = 0 Do Begin
If DirInfo.Attr And Directory = 0 Then
Inc (Result);
FindNext(DirInfo);
End;
FindClose (DirInfo);
End;
End. End.