home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / GENERAL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-03  |  4.5 KB  |  157 lines
  1. Unit General;
  2. {========================================================================}
  3. Interface
  4.   Uses
  5.     Dos, MfmDefs;
  6.   Function FileExt(InFileName : PathStr) : ExtStr;
  7.   Function FileExist(FileToCheck : PathStr) : Boolean;
  8.   Function DirExist(Var DirToCheck : PathStr) : Boolean;
  9.   Procedure MyErase(FileToErase : PathStr);
  10.   Procedure MyRename(InName, OutName : PathStr);
  11.   Function AnyKey : Byte;
  12.   Function HexByte(Hbb : Byte) : S2;
  13.   Function HexWord(Hww : Word) : S4;
  14.   Function HexDw(Hdw : LongInt) : S8;
  15.   Procedure ItoA2(I : Integer; Var Sp);
  16.   Function FormatDate(Date : Word) : String;
  17.   Function FormatTime(Time : Word) : String;
  18.   Procedure RemotePage;
  19. {========================================================================}
  20. Implementation
  21.   Uses
  22.     Crt, Screen;
  23. {========================================================================}
  24. Function FileExt(InFileName : PathStr) : ExtStr;
  25.   Begin
  26.     FSplit(InFileName,D,N,E);
  27.     FileExt := E;
  28.   End;
  29. {========================================================================}
  30. Function FileExist(FileToCheck : PathStr) : Boolean;
  31.   Begin
  32.     FindFirst(FileToCheck,Archive+ReadOnly+Hidden+SysFile,DirInfo);
  33.     If DosError = 0 Then FileExist := True Else FileExist := False;
  34.   End;
  35. {========================================================================}
  36. Function DirExist(Var DirToCheck : PathStr) : Boolean;
  37.   Var
  38.     DirSave : DirStr;
  39.   Begin
  40.     GetDir(0,DirSave);
  41.     If Copy(DirToCheck,Length(DirToCheck),1) = '\' Then Delete(DirToCheck,Length(DirToCheck),1);
  42.     {$I-} ChDir(DirToCheck); {$I+}
  43.     If IOresult = 0 Then DirExist := True Else DirExist := False;
  44.     DirToCheck := DirToCheck+'\';
  45.     ChDir(DirSave);
  46.   End;
  47. {========================================================================}
  48. Procedure MyErase(FileToErase : PathStr);
  49.   Var
  50.     Mef : File;
  51.   Begin
  52.     If FileExist(FileToErase) Then
  53.     Begin
  54.       Assign(Mef,FileToErase);
  55.       Erase(Mef);
  56.     End;
  57.   End;
  58. {========================================================================}
  59. Procedure MyRename(InName, OutName : PathStr);
  60.   Var
  61.     Mrf : File;
  62.   Begin
  63.     If FileExist(InName) Then
  64.     Begin
  65.       MyErase(OutName);
  66.       Assign(Mrf,InName);
  67.       Rename(Mrf,OutName);
  68.     End;
  69.   End;
  70. {========================================================================}
  71. Function AnyKey : Byte;
  72.   Begin
  73.     Write('Press any key to continue ');
  74.     AnyKey := GetInput;
  75.   End;
  76. {========================================================================}
  77. Function HexByte(Hbb : Byte) : S2;
  78.   Const
  79.     Hbc : Array[0..15] Of Char = '0123456789ABCDEF';
  80.   Var
  81.     Hbs : String[2];
  82.   Begin
  83.     Hbs := Hbc[Hbb Div 16] + Hbc[Hbb Mod 16];
  84.     If Length(Hbs) = 1 Then Hbs := '0' + Hbs;
  85.     HexByte := Hbs;
  86.   End;
  87. {========================================================================}
  88. Function HexWord(Hww : Word) : S4;
  89.   Begin
  90.     HexWord := HexByte(Hww Div 256) + HexByte(Hww Mod 256);
  91.   End;
  92. {========================================================================}
  93. Function HexDw(Hdw : LongInt) : S8;
  94.   Begin
  95.     HexDw := (HexWord(Hdw Shr 16)) + (HexWord(Hdw));
  96.   End;
  97. {========================================================================}
  98. Procedure ItoA2(I : Integer; Var Sp);
  99.   Var
  100.     S : Array[1..2] Of Char Absolute Sp;
  101.   Begin
  102.     S[1] := Chr((I Div 10)+Ord('0'));
  103.     S[2] := Chr((I Mod 10)+Ord('0'));
  104.   End;
  105. {========================================================================}
  106. Function FormatDate(Date : Word) : String;
  107.   Const
  108.     S : String[8] = 'mm-dd-yy';
  109.   Begin
  110.     ItoA2(((Date Shr 9) And 127)+80, S[7]);
  111.     ItoA2((Date Shr 5) And 15, S[1]);
  112.     ItoA2(Date And 31, S[4]);
  113.     FormatDate := S;
  114.   End;
  115. {========================================================================}
  116. Function FormatTime(Time : Word) : String;
  117.   Const
  118.     S : String[8] = 'hh:mm';
  119.   Begin
  120.     ItoA2((Time Shr 11) And 31, S[1]);
  121.     ItoA2((Time Shr 5) And 63, S[4]);
  122.     FormatTime := S;
  123.   End;
  124. {========================================================================}
  125. Procedure RemotePage;
  126.   Begin
  127.     Sound(444);
  128.     Delay(200);
  129.  
  130.     Sound(590);
  131.     Delay(40);
  132.  
  133.     Sound(790);
  134.     Delay(400);
  135.  
  136.     Sound(750);
  137.     Delay(150);
  138.  
  139.     Sound(590);
  140.     Delay(150);
  141.  
  142.     Sound(500);
  143.     Delay(200);
  144.  
  145.     Sound(670);
  146.     Delay(200);
  147.  
  148.     Sound(900);
  149.     Delay(400);
  150.  
  151.     NoSound;
  152.   End;
  153. {========================================================================}
  154. Begin
  155. End.
  156. {========================================================================}
  157.