eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A30

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
mdl/m_crc.pas
View File

@ -27,9 +27,10 @@ Unit m_CRC;
Interface
Function Crc16 (CP: Byte; CRC: Word) : Word;
Function Crc32 (Octet: Byte; CRC: LongInt) : LongInt;
Function FileCRC32 (FileName: String) : LongInt;
Function Crc16 (CP: Byte; CRC: Word) : Word;
Function Crc32 (Octet: Byte; CRC: LongInt) : LongInt;
Function FileCRC32 (FileName: String) : LongInt;
Function StringCRC32 (Str: String) : LongInt;
Implementation
@ -115,6 +116,16 @@ Begin
Crc32 := LongInt(CRC_32_TAB[Byte(CRC xor LongInt(Octet))] xor ((CRC shr 8) and $00FFFFFF));
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;
Var
InFile : File;

25
mdl/m_datetime.pas
View File

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

43
mdl/m_fileio.pas
View File

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