mysticbbs/mystic/mkcrap.pas

{$I M_OPS.PAS}

Unit mkcrap;

// this is various functions and procedures used by JAM/Squish...
// these should be removed and/or incorporated into mystic's code base as
// soon as possible.

// CHANGE JAM TEMP BUFFER.. ADD SETBUFFERFILE METHOD TO MSGBASE OBJECTS!!!!

interface

uses
 dos;

Function ToUnixDate(FDate: LongInt): LongInt;
Function DTToUnixDate(DT: DateTime): LongInt;
Procedure UnixToDT(SecsPast: LongInt; Var Dt: DateTime);
Function SaveFile(FN: String; Var Rec; FS: Word): Word;
Procedure Str2Az(Str: String; MaxLen: Byte; Var AZStr); {Convert string to asciiz}
Function FormattedDate(DT: DateTime; Mask: String): String;
Function LoadFile(FN: String; Var Rec; FS: Word): Word;
Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
Function GetFileSize (FN : String) : LongInt;
Function ExtendFile(FN: String; ToSize: LongInt): Word;
Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;

implementation

Uses
  m_FileIO,
  m_DateTime,
  m_Strings;

Const
  DATEC1970 = 2440588;
//  DATED0    =    1461;
//  DATED1    =  146097;
//  DATED2    = 1721119;

Function DTToUnixDate(DT: DateTime): LongInt;
Var
  SecsPast, DaysPast: LongInt;
Begin
  DateG2J (DT.Year, DT.Month, DT.Day, DaysPast);
  DaysPast := DaysPast - DATEc1970;
  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
  UnpackTime(Fdate, DT);
  ToUnixDate := DTToUnixDate(Dt);
End;

Procedure UnixToDT(SecsPast: LongInt; Var Dt: DateTime);
Var
  DateNum : LongInt;  //might be able to remove this
Begin
  Datenum := (SecsPast Div 86400) + DATEc1970;

  FillChar(DT, SizeOf(DT), 0);

  DateJ2G(DateNum, SmallInt(DT.Year), SmallInt(DT.Month), SmallInt(DT.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 SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
Var
  F: File;
  Error: Word;
  temp:longint;
Begin
  Error := 0;
  assign (f, fn);

  FileMode := fmReadWrite + fmDenyNone;
  If FileExist(FN) Then Begin
    reset(f,1);
    if ioresult <> 0 then error := ioresult;
  End Else Begin
    ReWrite(F,1);
    Error := IoResult;
  End;
  If Error = 0 Then Begin
    Seek(F, FPos);
    Error := IoResult;
  End;
  If Error = 0 Then
    If FS > 0 Then Begin
      If Not ioBlockWrite(F, Rec, FS, Temp) Then Error := ioCode;
    End;
  If Error = 0 Then Begin
    Close(F);
    Error := IoResult;
  End;
  SaveFilePos := Error;
End;

Function SaveFile(FN: String; Var Rec; FS: Word): Word;
   Begin
   SaveFile := SaveFilePos(FN, Rec, FS, 0);
   End;



Procedure Str2Az(Str: String; MaxLen: Byte; Var AZStr); {Convert string to asciiz}
        Begin
        If Length(Str) >= MaxLen Then
                Begin
                Str[MaxLen] := #0;
                Move(Str[1], AZStr, MaxLen);
                End
        Else
                Begin
                Str[Length(Str) + 1] := #0;
                Move(Str[1], AZStr, Length(Str) + 1);
                End;
        End;

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


Function FormattedDate(DT: DateTime; Mask: String): 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            := strUpper(Mask);
        DStr            := Copy(strPadL(strI2S(Dt.Day),         2, '0'),  1, 2);
        MStr            := Copy(strPadL(strI2S(Dt.Month), 2, '0'),  1, 2);
        YStr            := Copy(strPadL(strI2S(Dt.Year),  4, '0'),  1, 4);
        HourStr := Copy(strPadL(strI2S(Dt.Hour),  2, ' '),  1, 2);
        MinStr  := Copy(strPadL(strI2S(Dt.Min),         2, '0'),  1, 2);
        SecStr  := Copy(strPadL(strI2S(Dt.Sec),         2, '0'),  1, 2);
        MNStr   := MonthStr(Dt.Month);
        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 LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
Var
  F: File;
  Error: Word;
  NumRead: LongInt;
  Begin
  Error := 0;
  If Not FileExist(FN) Then Error := 8888;
  If Error = 0 Then assign (f, fn);
  FileMode := fmReadWrite + fmDenyNone;
  reset (f, 1);
  error := ioresult;
  If Error = 0 Then Begin
    Seek(F, FPos);
    Error := IoResult;
  End;
  If Error = 0 Then
    If Not ioBlockRead(F, Rec, FS, NumRead) Then
      Error := ioCode;
  If Error = 0 Then
    Begin
    Close(F);
    Error := IoResult;
    End;
  LoadFilePos := Error;
  End;

Function LoadFile(FN: String; Var Rec; FS: Word): Word;
  Begin
  LoadFile := LoadFilePos(FN, Rec, FS, 0);
  End;

Function GetFileSize (FN : String) : LongInt;
Var
  SR : SearchRec;
Begin
  FindFirst (FN, AnyFile, SR);
  If DosError = 0 Then
    GetFileSize := SR.Size
  Else
    GetFileSize := -1;
End;

Function ExtendFile(FN: String; ToSize: LongInt): Word;
{Pads file with nulls to specified size}
  Type
    FillType = Array[1..8000] of Byte;

  Var
    F: File;
    Error: Word;
    FillRec: ^FillType;
    temp:longint;

  Begin
  Error := 0;
  New(FillRec);
  If FillRec = Nil Then
    Error := 10;
  If Error = 0 Then
    Begin
    FillChar(FillRec^, SizeOf(FillRec^), 0);
    Assign(F, FN);
    FileMode := fmReadWrite + fmDenyNone;
    If FileExist(FN) Then Begin
      reset(f,1);
      if ioresult <> 0 then error := ioresult;
    End
    Else
      Begin
      ReWrite(F,1);
      Error := IoResult;
      End;
    End;
  If Error = 0 Then
    Begin
    Seek(F, FileSize(F));
    Error := IoResult;
    End;
  If Error = 0 Then
    Begin
    While ((FileSize(F) < (ToSize - SizeOf(FillRec^))) and (Error = 0)) Do
      Begin
      If Not ioBlockWrite(F, FillRec^, SizeOf(FillRec^), Temp) Then
        Error := ioCode;
      End;
    End;
  If ((Error = 0) and (FileSize(F) < ToSize)) Then Begin
    If Not ioBlockWrite(F, FillRec^, ToSize - FileSize(F), temp) Then
      Error := ioCode;
  End;
  If Error = 0 Then Begin
    Close(F);
    Error := IoResult;
  End;
  Dispose(FillRec);
  ExtendFile := Error;
  End;

End.