home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / MYMUD21.ZIP / MMUD21.ZIP / SOURCE / SOURCE.ZIP / MISC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-01-21  |  9.3 KB  |  353 lines
  1. {$I COPYRGHT.INC}
  2.  
  3. (*----------------------------------------------------------------------------*
  4.  
  5.   General misc. fucntions and procedures.
  6.  
  7.  *---------------------------------------------------------------------------*)
  8.  
  9.  
  10. Unit Misc;
  11. Interface
  12. Uses Dos;
  13.  
  14.  
  15. (*---------------------------------------------------------------------------*
  16.    UpStr    Convert a string to uppercase
  17.    MakeStr  Add a CHAR to a string until the length is LEN
  18.  *---------------------------------------------------------------------------*)
  19. Function UpStr(S : String):String;
  20. Function MakeStr(S : String;C : Char;Len : Byte):String;
  21.  
  22. (*---------------------------------------------------------------------------*
  23.   Convert Nr to string and viceversa
  24.  *---------------------------------------------------------------------------*)
  25. Function Nr2Str(Nr : Integer):String;
  26. Function Str2Nr(S : String):Integer;
  27. Function Nr2FStr(Nr : Integer;Len : Byte):String;
  28.  
  29. (*---------------------------------------------------------------------------*
  30.   Clean up an string. Delete leading and trailing spaces
  31.  *---------------------------------------------------------------------------*)
  32. Function CleanUp(S : String):String;
  33.  
  34. (*---------------------------------------------------------------------------*
  35.   MakeTimeString     Convert a longint timestamp to a string
  36.   TimeStamp          Return a complete time/date string
  37.  *---------------------------------------------------------------------------*)
  38. Function MakeTimeString(Stamp : LongInt):String;
  39. Function TimeStamp:String;
  40.  
  41. (*---------------------------------------------------------------------------*
  42.    Splits a commandline <Object>=<Action> in the object and the action
  43.    part
  44.  *---------------------------------------------------------------------------*)
  45. Function SplitCommand(     InpStr : String;
  46.                        Var ObjName: String;
  47.                        Var Action : String):Boolean;
  48.  
  49. (*---------------------------------------------------------------------------*
  50.   BitLevel functions
  51.  *---------------------------------------------------------------------------*)
  52.  
  53. Procedure ReSetBit(Var L : LongInt; Flag : LongInt);
  54. Procedure SetBit(Var L : LongInt; Flag : LongInt);
  55. Function BitSet(L,Flag : LongInt):Boolean;
  56.  
  57. (*---------------------------------------------------------------------------*
  58.   Check if a file exists
  59.  *---------------------------------------------------------------------------*)
  60. Function ExistFile(FilePath : ComStr):Boolean;
  61. Procedure CompletePath(Var Path : String);
  62. Function GetHomeDir(EVar : String):PathStr;
  63. Function DeleteFile(FileSpec : PathStr): Boolean;
  64. Function FullName(FileName : ComStr):ComStr;
  65. Function PickFile(Path : ComStr;FileName : String):ComStr;
  66. Function NameOnly(F : ComStr):String;
  67. Procedure MakeDir(Path : PathStr);
  68. Function ExistDir(Path : PathStr):Boolean;
  69. Function GetToken(Var Line : String;DoUp : Boolean):String;
  70. Function ChangePathTo(FileName : ComStr;NewPath : PathStr):ComStr;
  71.  
  72. Implementation
  73.  
  74. (*--------------------------------------------------------------------------*)
  75. Function ExistFile(FilePath : ComStr):Boolean;
  76. Var Zoek: SearchRec;
  77. Begin
  78. FindFirst(FilePath,AnyFile,Zoek);
  79. ExistFile:=(DosError=0);
  80. End;
  81.  
  82. (*---------------------------------------------------------------------------*)
  83. Function UpStr(S : String):String;
  84. Var C : Byte;
  85. Begin
  86. For C:=1 To Length(S) Do
  87.  S[C]:=Upcase(S[C]);
  88. UpStr:=S;
  89. End;
  90.  
  91. (*---------------------------------------------------------------------------*)
  92. Function Nr2Str(Nr : Integer):String;
  93. Var Temp : String;
  94. Begin
  95. Str(Nr,Temp);
  96. Nr2Str:=Temp;
  97. End;
  98.  
  99. Function Nr2FStr(Nr : Integer;Len : Byte):String;
  100. Var Temp : String;
  101. Begin
  102. Str(Nr:Len,Temp);
  103. Nr2FStr:=Temp;
  104. End;
  105.  
  106. (*---------------------------------------------------------------------------*)
  107. Function Str2Nr(S : String):Integer;
  108. Var Err : Integer;
  109.     Tmp : Integer;
  110. Begin
  111. Val(S,Tmp,Err);
  112. If Err<>0
  113.    Then Tmp:=0;
  114. Str2Nr:=Tmp
  115. End;
  116.  
  117.  
  118. (*---------------------------------------------------------------------------*)
  119. Function CleanUp(S : String):String;
  120. Begin
  121. While (S<>'') and (S[1]=' ') Do Delete(S,1,1);
  122. While (S<>'') And (S[Length(S)]=' ') Do Dec(S[0]);
  123. CleanUp:=S;
  124. End;
  125.  
  126. (*---------------------------------------------------------------------------*)
  127. Function SplitCommand(     InpStr : String;
  128.                        Var ObjName: String;
  129.                        Var Action : String):Boolean;
  130. Begin
  131. SplitCommand:=False;
  132. If Pos('=',InpStR)=0
  133.    Then Exit;
  134. ObjName:=Copy(InpStr,1,Pos('=',InpStr)-1);
  135. Action:=InpStr;
  136. Delete(Action,1,Length(ObjName)+1);
  137. SplitCommand:=True;
  138. End;
  139.  
  140. (*---------------------------------------------------------------------------*)
  141. Function Nr2DTStr(Nr : Word):String;
  142. Var Tmp : String;
  143. Begin
  144. Str(Nr:2,Tmp);
  145. If Tmp[1]=' '
  146.    Then Tmp[1]:='0';
  147. Nr2DTStr:=Tmp;
  148. End;
  149.  
  150.  
  151. (*---------------------------------------------------------------------------*)
  152. Function MakeTimeString(Stamp : LongInt):String;
  153. Var D       : DateTime;
  154.     Tmp     : String[5];
  155. Begin
  156. UnpackTime(Stamp,D);
  157. Tmp:=Nr2DTStr(D.Hour)+':'+Nr2DTStr(D.Min);
  158. MakeTimeString:=Tmp;
  159. End;
  160.  
  161.  
  162. (*---------------------------------------------------------------------------*)
  163. Const MonthList : Array[1..12] Of String[3] =
  164.        ('Jan','Feb','Mar','Apr','May','Jun',
  165.         'Jul','Aug','Sep','Oct','Nov','Dec');
  166.  
  167. Function TimeStamp:String;
  168. Var Year,Month,Day,
  169.     Hour,Minute,Seconds     : Word;
  170.     Dum                     : Word;
  171. Begin
  172. GetTime(Hour,Minute,Seconds,Dum);
  173. GetDate(Year,Month,Day,Dum);
  174. Dec(Year,1900);
  175.  
  176. TimeStamp:= Nr2DTStr(Hour)         +':'+
  177.             Nr2DTStr(Minute)       +':'+
  178.             Nr2DTStr(Seconds)      +' ('+
  179.             Nr2DTStr(Day)          +' '+
  180.             MonthList[Month]       +' '+
  181.             Nr2DTStr(Year)         +')';
  182.  
  183. End;
  184.  
  185. Function MakeStr(S : String;C : Char;Len : Byte):String;
  186. Begin
  187. While Length(S)<Len Do
  188.  S:=S+C;
  189. MakeStr:=S;
  190. End;
  191.  
  192.  
  193. Function BitSet(L,Flag : LongInt):Boolean;
  194. Begin
  195. BitSet:=(L And Flag)=Flag;
  196. End;
  197.  
  198. Procedure SetBit(Var L : LongInt; Flag : LongInt);
  199. Begin
  200. L:=L Or Flag;
  201. End;
  202.  
  203. Procedure ReSetBit(Var L : LongInt; Flag : LongInt);
  204. Begin
  205. L:=L And (Flag Xor $FFFFFFFF);
  206. End;
  207.  
  208. Procedure CompletePath(Var Path : String);
  209. Begin
  210. Path:=FExpand(Path);
  211. If (Path[Length(Path)]<>'\') And
  212.    (Path[Length(Path)]<>':')
  213.    Then Path:=Path+'\';
  214. End;
  215.  
  216.  
  217. Function GetHomeDir(EVar : String):PathStr;
  218. Var Tmp : String;
  219.     Dum : String[10];
  220. Begin
  221. Tmp:=GetEnv(EVAR);
  222. If Tmp='' Then FSplit(ParamStr(0),Tmp,Dum,Dum);
  223. CompletePath(Tmp);
  224. GetHomeDir:=Tmp;
  225. End;
  226.  
  227. Function DeleteFile(FileSpec : PathStr): Boolean;
  228. Var Search : SearchRec;
  229.     Path   : PathStr;
  230.     Tel    : Byte;
  231.     Inp    : File;
  232. Begin
  233. DeleteFile:=True;
  234. Tel:=Length(FileSpec);
  235. While (Tel>0) And Not (FileSpec[Tel] In ['\',':']) Do
  236.  Dec(Tel);
  237. Path:=Copy(FileSpec,1,Tel);
  238. FindFirst(FileSpec,Archive,Search);
  239. While DosError=0 Do
  240.  Begin
  241.  If (Search.Attr And Directory)<>Directory
  242.     Then Begin
  243.          Assign(Inp,Path+Search.Name);
  244.          Erase(Inp);
  245.          If IoResult<>0
  246.             Then Begin
  247.                  SetFAttr(Inp,0);
  248.                  Erase(Inp);
  249.                  If IoResult<>0
  250.                     Then Begin
  251.                          DeleteFile:=False;
  252.                          Exit;
  253.                          End;
  254.                  End;
  255.          End;
  256.  FindNext(Search);
  257.  End;
  258. If IoResult<>0
  259.    Then;
  260. End;
  261.  
  262. Function NameOnly(F : ComStr):String;
  263. Var Name,Ext : String[10];
  264.     P        : PathStr;
  265. Begin
  266. FSplit(F,P,Name,Ext);
  267. NameOnly:=Name+Ext;
  268. End;
  269.  
  270. Var Hlp : Byte;
  271.  
  272. Procedure MakeDir(Path : PathStr);
  273. Var Mem : String[12];
  274. Begin
  275. If Path='' Then Exit;
  276. MkDir(Path);
  277. If IoResult=3
  278.    Then Begin
  279.         Hlp:=Length(Path);
  280.         While (Hlp>0) and (Path[Hlp]<>'\') do
  281.          Dec(Hlp);
  282.         Mem:=Copy(Path,Hlp+1,Length(Path)-Hlp);
  283.         Path[0]:=Chr(Hlp-1);
  284.         MakeDir(Path);
  285.         MkDir(Path+'\'+Mem);
  286.         If IoResult<>0
  287.            Then Exit;
  288.         End;
  289. End;
  290.  
  291. Function ExistDir(Path : PathStr):Boolean;
  292. Var S : SearchRec;
  293. Begin
  294. ExistDir:=True;
  295. CompletePath(Path);
  296. If (Length(Path)=3) and (Path[2]=':')
  297.    Then Exit;
  298. Dec(Path[0]);
  299. FindFirst(Path,Directory,S);
  300. ExistDir:=(DosError=0) And ((S.Attr and Directory)=Directory);
  301. End;
  302.  
  303. Function FullName(FileName : ComStr):ComStr;
  304. Var S : SearchRec;
  305. Begin
  306. FindFirst(FileName+'.*',AnyFile,S);
  307. While (DosError=0) And ((S.Attr and Directory)=Directory) Do
  308.  FindNext(S);
  309. If DosError=0
  310.    Then FullName:=S.Name
  311.    Else FullName:=FileName+'.???';
  312. End;
  313.  
  314. Function PickFile(Path : ComStr;FileName : String):ComStr;
  315. Var S : SearchRec;
  316. Begin
  317. FindFirst(Path+FileName,AnyFile,S);
  318. If DosError=0
  319.    Then PickFile:=Path+S.Name
  320.    Else PickFile:='';
  321. End;
  322.  
  323. Function GetToken(Var Line : String;DoUp : Boolean):String;
  324. Var Tmp : Byte;
  325.     Out : String;
  326. Begin
  327. Tmp:=1;
  328. Out:='';
  329. While (Line[1] in [' ',#09]) And (Line<>'') Do
  330.   Delete(Line,1,1);
  331.  
  332. While (Tmp<=Length(Line)) And (Line[Tmp]<>' ') Do
  333.  Begin
  334.  If DoUp
  335.     Then Out:=Out+Upcase(Line[Tmp])
  336.     Else Out:=Out+Line[Tmp];
  337.  Inc(Tmp);
  338.  End;
  339. Delete(Line,1,Length(Out)+1);
  340.  
  341. While (Line[1] in [' ',#09]) And (Line<>'') Do
  342.   Delete(Line,1,1);
  343.  
  344. GetToken:=Out;
  345. End;
  346.  
  347. Function ChangePathTo(FileName : ComStr;NewPath : PathStr):ComStr;
  348. Begin
  349. ChangePathTo:=NewPath+NameOnly(FileName);
  350. End;
  351.  
  352. End.
  353.