Contributor: TOBIN FRICKE
Unit Usefull;
{ Copyright (C) 1995 by Tobin T. Fricke, All Rights Reserved }
{ Use this and have fun, but tell me first. BBS 714-586-6142 }
{ Make sure to mention that you used this in your documentation of your }
{ program(s) if you do use it. Thanks. }
{ I didn't write all of the routines, but I wrote most of them. }
{ If you use this, I'd appreciate it if you could send me a postcard }
{ from where you live, or at least send me an email. My email address }
{ is tobin@mail.edm.net. If that doesn't work, try using }
{ fricke@roboben.engr.ucdavis.edu. My postal address is: }
{ 25001 El Cortijo Ln., Mission Viejo, CA 92691-5236, USA. Thanks! }
{ Updated May 1995 }
Interface
{$IFDEF WINDOWS}
type
{ Date & time recored used by PackTime }
{ and UnpackTime }
DateTime = record
Year,Month,Day,Hour,Min,Sec: Word;
end;
{$ENDIF}
Type MIDRecord = Record
InfoLevel : Word;
SerialNum : LongInt; {This is the serial number...}
VolLabel : Array[1..11] of Char;
FatType : Array[1..8] of Char;
End;
{$IFNDEF OS2} Function Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;
{$ENDIF}
Function LongToHex(L:Longint):String;
Function Center(S:String; B:Byte):String;
{Center returns a S, centered with spaces, of length B }
Function Left(S:String; B:Byte):String;
{ returns a Left-Justied string, length B }
Function PadRight(S:String; B:Byte; C:Char):String;
{ returns S padded with B of C on the Right }
Function Right(S:String; B:Byte):String;
{ same as Left, but right-justifies }
function FileExists(FileName: String): Boolean;
{ does Filename Exist? }
Function UpString(S:String):String;
{ Returns S in upper case }
Function LoString(S:String):String;
{ Returns S in lower case }
Function LoCase(C:Char):Char;
{ Returns C in lower case }
Function Str(X:integer):String;
{ Converts X to a string }
Function Strw(X:Word):String;
{ Convert a Word to a String }
Function Strl(X:LongInt):String;
Function StrR(X:Real):String;
Function WhatDir:String;
Function Val(S:String):Integer;
Function ValW(S:String):Word;
Function ValL(S:String):longint;
Function Rep(S:String; C:Word):String;
Function TempFile( Path: STRING ): STRING;
Function SizeOfFile(S:String):LongInt;
Function NameCaps(S:String):String;
{ Capitalize The First Letter Of Each Word }
Function Del(S:String; Index: Integer; Count:Integer):String;
{ Delete, but as a function }
Function Strip_(S:String):String;
{ Changes _'s to spaces }
Function ActualFileSize:LongInt;
{ How big is your EXE? }
Procedure Lines(S:String);
Procedure Lines50; { Go into 50 lines-mode}
Procedure Lines25;
Procedure Lines35;
{$IFNDEF OS2}
Function NetworkDrive(Drive:Char):Boolean;
{$ENDIF}
Function StrBool(S:String):Boolean;
Procedure SwapStr(Var A,B:String);
{ Swaps A and B: C=A; A=B; B=C; }
Procedure ConvertBase(BaseN:Byte; BaseNNumber:String;
BaseZ:Byte; var BaseZNumber:String);
{ Converts base 2-36 to base 2-36 }
Function WordWrap(S:String; Var Remainder:String; Len:Byte):String;
{ Tobin's wonder-word-wrap. }
Function AN(S:String):String;
{ prepends "a " or "an " to S, based on the first letter }
Function LastDrive: Char;
var UError:Word;
Implementation
{$IFDEF WINDOWS}
Uses WinCRT, WinDOS;
{$ELSE}
Uses CRT, DOS;
{$ENDIF}
{$IFNDEF OS2}
Function Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;
Var Result : Word;
Var Regs : Registers;
Begin
FillChar(Mid,SizeOf(Mid),0);
FillChar(Regs,SizeOf(Regs),0);
With Regs DO
Begin
AX := 440ドルD;
BX := Drive;
CX := 0866ドル;
DS := Seg(Mid);
DX := Ofs(Mid);
Intr(21,ドルRegs);
Case AX of
01ドル : Label_Fat := False;
02ドル : Label_Fat := False;
05ドル : Label_Fat := False;
Else Label_Fat := True;
End;
End;
End;
{$ENDIF}
(*
Var Mid : MidRecord;
Begin
ClrScr;
If Label_Fat(Mid,0) Then
With Mid DO
Begin
Writeln(SerialNum);
Writeln(VolLabel);
Writeln(FatType);
End
Else Writeln('Error Occured');
End.
*)
Procedure ConvertBase(BaseN:Byte; BaseNNumber:String;
BaseZ:Byte; var BaseZNumber:String);
var
I: Integer;
Number,Remainder: LongInt;
begin
Number := 0;
for I := 1 to Length (BaseNNumber) do
case BaseNNumber[I] of
'0'..'9': Number := Number * BaseN + Ord (BasenNumber[I]) - Ord ('0');
'A'..'Z': Number := Number * BaseN + Ord (BasenNumber[I]) -
Ord ('A') + 10;
'a'..'z': Number := Number * BaseN + Ord (BasenNumber[I]) -
Ord ('a') + 10;
end; BaseZNumber := ''; while Number> 0 do
begin
Remainder := Number mod BaseZ;
Number := Number div BaseZ;
case Remainder of
0..9: BaseZNumber := Char (Remainder + Ord ('0')) + BaseZNumber;
10..36: BaseZNumber := Char (Remainder - 10 + Ord ('A')) + BaseZNumber;
end;
end; end;
Procedure SwapStr(Var A,B:String);
var C:String;
begin
C:=A;
A:=B;
B:=C;
end;
{$IFDEF XXX}
Type Registers = record
case Integer of
0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Word);
1: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
end;
{$ENDIF}
{$IFNDEF OS2}
FUNCTION NetworkDrive (Drive:CHAR):BOOLEAN;
{$Ifdef windows} var reg:Tregisters; {$else} var Reg:Registers; {$endif}
var DosErrorCode:Word;
BEGIN
Drive := UpCase (Drive); { Drive _must_ be 'A'..'Z' }
IF (Drive IN ['A'..'Z']) THEN BEGIN { make sure of 'A'..'Z' }
Reg.BL := ORD(Drive) - 64; { 1 = A:, 2 = B:, 3 = C: etc. }
Reg.AX := 4409ドル; { Dos fn: check if dev remote }
MsDos (Reg); { call Dos' services }
IF ODD(Reg.FLAGS) THEN { Dos reports function error? }
DosErrorCode := Reg.AX { yes: return Dos' error code }
ELSE BEGIN { else ... }
DosErrorCode := 0; { 0 = no error was detected }
IF ODD(Reg.DX SHR 12) THEN { is Drive remote? }
NetworkDrive := TRUE { yes: return TRUE }
ELSE
NetworkDrive := FALSE; { no: return FALSE }
{END IF ODD(Reg.DX...}
END; {IF ODD(Reg.FLAGS)}
END; {IF Drive}
END {NetworkDrive};
{$ENDIF}
Function SizeofFile(S:String):LongInt;
var F:File;
begin
Assign(F,S);
FileMode:=0;
Reset(F,1);
SizeOfFile:=FileSize(F);
Close(F);
end;
Function ActualFileSize:LongInt;
var F:File;
begin
ActualFileSize:=SizeOfFile(ParamStr(0));
end;
Procedure Lines50; Assembler;
ASM
MOV AH, 11H
MOV AL, 12H
MOV BL, 0
INT 10H
END;
Procedure Lines25; Assembler;
ASM
MOV AH, 11H
MOV AL, 14H
MOV BL, 0
INT 10H
END;
Procedure Lines35; Assembler;
ASM
MOV AH, 11H
MOV AL, 11H
MOV BL, 0
INT 10H
END;
Procedure Lines(S:String);
Begin
If Val(S)=50 then Lines50;
If Val(S)=25 then Lines25;
If Val(S)=35 then Lines35;
End;
Function Strip_(S:String):String;
var B:Byte;
begin
For B:=1 to length(S) do if S[B]='_' then S[B]:=' ';
Strip_:=S;
end;
Function Del(S:String; Index:Integer; Count:Integer):String;
begin
Delete(S,Index,Count);
Del:=S;
end;
Function WhatDir:String;
var s:String;
begin
GetDir(0,s);
whatdir:=s;
end;
Function Str(X:integer):String;
var S:String;
Begin
System.Str(X,S);
Str:=S;
End;
Function StrL(X:LongInt):String;
var S:String;
Begin
System.Str(X,S);
StrL:=S;
End;
Function StrW(X:word):String;
var S:String;
Begin
System.Str(X,S);
StrW:=S;
End;
Function StrR(X:Real):String;
var S:String;
Begin
System.Str(X,S);
StrR:=S;
End;
Function Val(S:String):Integer;
var A,B:Integer;
begin
System.Val(S,A,B);
If B=0 then Val:=A else begin Val:=0; UError:=B; End;
end;
Function ValW(S:String):Word;
var B:Integer;
A:Word;
begin
System.Val(S,A,B);
If B=0 then ValW:=A else begin ValW:=0; UError:=B; End;
end;
Function ValL(S:String):longint;
var B:integer;
A:longint;
begin
System.Val(S,A,B);
If B=0 then Vall:=A else begin Vall:=0; UError:=B; End;
end;
Function Upstring(S:String):String;
var
I:Byte;
begin
for i := 1 to Length(s) do s[i] := UpCase(s[i]);
Upstring:=S;
end;
Function LoCase(C:Char):Char;
begin
If (Ord(C)>64) and (Ord(C)<91) then LoCase:=Char(Ord(C)+32) else LoCase:=C; end; Function LoString(S:String):String; var I:Byte; begin for i := 1 to Length(s) do s[i] := LoCase(s[i]); Lostring:=S; end; Function NameCaps(S:String):String; var I:byte; begin S:=LoString(S); S[1]:=UpCase(S[1]); For I:=1 to Length(S) do If S[I]=' ' then if I '');
end; { FileExists }
Function Center(S:String; B:Byte):String;
var A:Byte;
Begin
Repeat
A:=Length(S) div 2;
If A<(b Div 2) then S:=' '+S+' '; Until (Length(S) div 2)>=((B) Div 2);
If Length(S)=((B));
While Length(S)>B do Delete(S,Length(S),1);
Left:=S;
End;
Function PadRight(S:String; B:Byte; C:Char):String;
var A:Byte;
Begin
Repeat
A:=Length(S);
If A=(B));
PadRight:=S;
End;
Function Right(S:String; B:Byte):String;
Begin
Right:=PadRight(S,B,' ');
End;
Function Rep(S:String; C:Word):String;
var W:Word;
T:String;
begin
T:='';
For W:=1 to C do T:=T+S;
Rep:=T;
end;
Function StrBool(S:String):Boolean;
begin
S:=UpString(S);
StrBool:=(Pos('T',S)>0);
end;
FUNCTION TempFile( Path: STRING ): STRING;
VAR
{$IFDEF WINDOWS}
DateStr : TDateTime;
{$ELSE}
DateStr : DateTime;
{$ENDIF}
Trash : WORD;
Time : LONGINT;
FileName : STRING;
Begin
If (Path'') AND (Path[length(Path)]'\') Then Path := Path + '\';
Repeat
With DateStr Do
Begin
GETDATE( Year, Month, Day, Trash );
GETTIME( Hour, Min, Sec, Trash );
End;
PackTime( DateStr, Time );
{$R-,Q-}
System.Str(Time,Filename);
FileName := Copy(Filename,1,8);
FileName := Filename+'.$$$';
{$R+,Q+}
Until Not FileExists(Path + FileName);
TempFile := Path + FileName;
END;
Function WordWrap(S:String; Var Remainder:String; Len:Byte):String;
Var W:String;
I:Integer;
begin
If S[1]=' ' then delete(S,1,1);
If Length(S)<=len then
begin
WordWrap:=S;
Remainder:='';
Exit;
end;
For I:=Len downto 1 do
begin
If S[I]=' ' then
begin
WordWrap:=Copy(S,1,I);
Remainder:=Copy(S,I,Length(S)-I+1);
Exit;
end;
end;
end;
Function AN(S:String):String;
begin
While S[1]=' ' do delete(S,1,1);
If UPCASE(S[1]) IN ['A','E','I','O','U'] THEN INSERT('an ',S,1) ELSE
INSERT('a ',S,1);
AN:=S;
end;
Function LastDrive: Char; Assembler;
Asm
mov ah, 19h
int 21h
push ax { save default drive }
mov ah, 0Eh
mov dl, 19h
int 21h
mov cl, al
dec cx
@@CheckDrive:
mov ah, 0Eh { check if drive valid }
mov dl, cl
int 21h
mov ah, 19h
int 21h
cmp cl, al
je @@Valid
dec cl { check next lovest drive number }
jmp @@CheckDrive
@@Valid:
pop ax
mov dl, al
mov ah, 0Eh
int 21h { restore default drive }
mov al, cl
add al, 'A'
end;
Function LongToHex(L:Longint):String;
var S:string;
begin
ConvertBase(10,StrL(L),16,S);
LongToHex:=S;
end;
End.