home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
progm
/
tptools.zip
/
FIRSTED.ZIP
/
EDSTRING.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-12-21
|
7KB
|
219 lines
{ EDSTRING.PAS
ED 4.0
Copyright (c) 1985, 87 by Borland International, Inc. }
{$I eddirect.inc}
unit EdString;
interface
uses
Dos, {DOS calls - standard unit}
Errors, {Runtime error handler}
EdVars; {Global types and declarations}
function EdStringEmpty(var S) : Boolean;
{-Return true if string is empty}
procedure EdClearString(var S);
{-Set s to a null string}
function EdEndOfPath(Path : Filepath) : Filepath;
{-Return just the filename part of a pathname}
function EdFileHasExtension(Fname : Filepath; var DotPos : Integer) : Boolean;
{-Return whether and position of extension separator dot in a filename}
procedure EdDefaultExtension(Ext : VarString; var Fname : Filepath);
{-Assign a default extension to a file name}
procedure EdCleanFileName(var Fname : Filepath);
{-Return a cleaned up file name}
function EdControlFilter(Ch : Char) : Char;
{-Return control char equivalent of upper/lower/control char}
procedure EdLongUpcase(var Buffer; Size : Integer);
{-Fast uppercasing routine. buffer is a textline or a standard string}
function EdLongPosFwd(var Buffer; Start, Size : Integer; var Pattern : VarString) : Integer;
{-return the position of pattern in buffer, or 0 if not found}
function EdLongPosBack(var Buffer; Start : Integer; var Pattern : VarString) : Integer;
{-return the position of pattern in buffer, or 0 if not found}
{==========================================================================}
implementation
{$L EDSTRING}
procedure EdLongUpcase(var Buffer; Size : Integer); external;
function EdLongPosFwd(var Buffer; Start, Size : Integer;
var Pattern : VarString) : Integer; external;
function EdLongPosBack(var Buffer; Start : Integer;
var Pattern : VarString) : Integer; external;
function EdStringEmpty(var S) : Boolean;
{-Return true if string is empty}
var
Len : Byte absolute S;
begin {EdStringEmpty}
EdStringEmpty := (Len = 0);
end; {EdStringEmpty}
procedure EdClearString(var S);
{-Set s to a null string}
var
Len : Byte absolute S;
begin {EdClearString}
Len := 0;
end; {EdClearString}
function EdEndOfPath(Path : Filepath) : Filepath;
{-Return just the filename part of a pathname}
const
Delim : Charset = [':', '\'];
var
I : Integer;
begin {EdEndOfPath}
I := Length(Path);
repeat
Dec(I);
until (I < 1) or (Path[I] in Delim);
EdEndOfPath := Copy(Path, Succ(I), 64);
end; {EdEndOfPath}
function EdFileHasExtension(Fname : Filepath; var DotPos : Integer) : Boolean;
{-Return whether and position of extension separator dot in a filename}
var
I : Integer;
begin {EdFileHasExtension}
DotPos := 0;
for I := Length(Fname) downto 1 do
if (Fname[I] = Period) and (DotPos = 0) then
DotPos := I;
EdFileHasExtension := (DotPos > 0) and (Pos('\', Copy(Fname, Succ(DotPos), 64)) = 0);
end; {EdFileHasExtension}
procedure EdDefaultExtension(Ext : VarString; var Fname : Filepath);
{-Assign a default extension to a file name}
var
DotPos : Integer;
begin {EdDefaultExtension}
if not(EdFileHasExtension(Fname, DotPos)) then
Fname := Fname+Period+Ext;
end; {EdDefaultextension}
procedure EdUpcase(var S : VarString);
{-Convert lower case letters in string to uppercase}
var
I : Integer;
begin {EdUpcase}
for I := 1 to Length(S) do
S[I] := Upcase(S[I]);
end; {EdUpcase}
{***}
procedure EdCleanFileName(var Fname : Filepath);
{-Return a cleaned up file name}
const
Delim : Charset = [':', '\'];
var
I, DotPos : Integer;
function EdExpandPath(Fname : Filepath) : Filepath;
{-Return a complete path}
var
Cd : Filepath;
Drive, ColPos : Byte;
begin {EdExpandPath}
ColPos := Pos(':', Fname);
if ColPos <> 0 then begin
if Fname[Succ(ColPos)] = '\' then
{Complete path already specified}
EdExpandPath := Fname
else begin
{Drive specified, but incomplete path}
Drive := Pos(Upcase(Fname[1]), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
Delete(Fname, 1, ColPos);
GetDir(Drive, Cd);
if Cd[Length(Cd)] <> '\' then
Cd := Cd+'\';
EdExpandPath := Cd+Fname;
end;
end else begin
if Fname[1] = '\' then begin
{Complete path but no drive}
GetDir(0, Cd);
EdExpandPath := Copy(Cd, 1, 2)+Fname;
end else begin
{No drive, incomplete path}
GetDir(0, Cd);
if Cd[Length(Cd)] <> '\' then
Cd := Cd+'\';
EdExpandPath := Cd+Fname;
end;
end;
end; {EdExpandPath}
begin {EdCleanFileName}
EdUpcase(Fname);
{Strip leading blanks}
while (Length(Fname) > 0) and (Fname[1] = Blank) do
Delete(Fname, 1, 1);
{Strip trailing blanks and characters trailing blanks}
I := Pos(Blank, Fname);
if I <> 0 then
Delete(Fname, I, 64);
if EdFileHasExtension(Fname, DotPos) then begin
{Check for extension too long}
if Length(Fname)-DotPos > 3 then
Delete(Fname, DotPos+4, 64)
end else
DotPos := Succ(Length(Fname));
{Check for file name too long}
I := DotPos;
repeat
Dec(I);
until (I <= 0) or (Fname[I] in Delim);
while (DotPos-I) > 9 do begin
Delete(Fname, Pred(DotPos), 1);
Dec(DotPos);
end;
{Expand fname to a complete path}
Fname := EdExpandPath(Fname);
end; {EdCleanFileName}
function EdControlFilter(Ch : Char) : Char;
{-Return control char equivalent of upper/lower/control char}
begin {EdControlFilter}
{Perform upcase function}
case Ch of
'a'..'z' : Ch := Chr(Ord(Ch)-32);
end;
{Perform control shifting function}
case Ch of
'A'..'Z' : EdControlFilter := Chr(Ord(Ch)-64);
else
EdControlFilter := Ch;
end;
end; {EdControlFilter}
end.