Shareware Overload/ShartewareOverload.cdr/progm/tptools.zip/FIRSTED.ZIP/EDSTRING.PAS

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.