tools.pas

还是一个词法分析程序

{************************************************}
{                                                }
{   Turbo Vision File Manager Demo               }
{   Copyright (c) 1992 by Borland International  }
{                                                }
{************************************************}

unit Tools;

{$X+,V-}

interface

uses Drivers, Objects, Views, Dialogs, Memory, App, MsgBox,
  Globals, FileCopy, Gauges, Dos;

type
  String2 = String[2];
  String4 = String[4];
  TConfigHeader = String[24];

  { Used to display status messages }
  PStatusBox = ^TStatusBox;
  TStatusBox = object(TDialog)
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  { buffered file copy object }
  PCopier = ^TCopier;
  TCopier = object(TFileCopy)
    procedure ReadMsg(const FName: FNameStr; Progress: Longint); virtual;
    procedure WriteMsg(const FName: FNameStr; Progress: Longint); virtual;
    function IOError(const FName: FNameStr; ECode:Integer) : erAction; virtual;
  end;

  { generate a cmOK if double clicked }
  POkListBox = ^TOkListBox;
  TOkListBox = object(TListBox)
    procedure SelectItem(Item: Integer); virtual;
  end;

{ ShowStatusBox displays a status dialog, using StatusMsg as the string }
{ to display. The status box responds to the cmStatusUpdate command by  }
{ redrawing the text.                                                   }
procedure ShowStatusBox;

{ KillStatusBox removes the status box from the screen }
procedure KillStatusBox;

{ Return True if the passed list contains any tagged files }
function HasTaggedFiles(P: PFileList) : Boolean;

{ Return the path and filename (no extension) of the exe }
function GetExeBaseName: String;

{ Convert strings to upper and lower case }
procedure UpperCase(var s: String);
procedure LowerCase(var s: String);

{ Return a right justified number (in an 8 character field) }
function RJustNum(L: Longint): String;

{ Pad right end of string to Len bytes }
function Pad(s: String; Len: Byte): String;

{ Return a fully trimmed copy of Original }
function FullTrim(const Original: String): String;

{ Return string value of W, optionally with leading zero if Pad=True }
function TwoDigit(W: Word; Pad: Boolean): String2;

{ Return 4 digit string representation of W }
function FourDigit(W: Word): String4;

{ Return a string version of the Date/Time longint. Opts=$01 adds the }
{ date portion. Opts=$02 adds time, Opts=$03 adds both                }
function FormatDateTime(DT: Longint; Opts: Word): String;

{ Return the 4 character string representation of the attribute word }
function FormatAttr(Attr: Word): String4;

{ Return True if file is a .BAT, .COM, or .EXE }
function IsExecutable(const FileName: FNameStr): Boolean;

{ Execute the passed file, asks for parameters }
procedure ExecuteFile(FileName: FNameStr);

{ View passed file as Hex, Text, or with Custom Viewer }
procedure ViewAsHex(const FileName: FNameStr);
procedure ViewAsText(const FileName: FNameStr);
procedure ViewCustom(const FileName: FNameStr);

{ Return True if the passed drive letter is valid }
function DriveValid(Drive: Char): Boolean;

{ Return a selected drive letter from listbox of valid drives }
function SelectDrive: Char;

{ Invalidate the passed directory by issuing a cmInvalidDir broadcast }
procedure InvalidateDir(Path: FNameStr);

{ Copy either tagged or current file to a destination path }
procedure HandleFileCopy(const Path: FNameStr; P: PFileList; Current: Integer);

{ Delete file if user confirms the deletion, return error code }
function SafeDelete(FileName: FNameStr): Integer;

{ Handle deleting one or multiple files from a file list }
procedure HandleFileDelete(const Path: FNameStr; List: PFileList;
  Current: Integer);

{ Present the Rename file dialog }
procedure RenameFile(const Path: FNameStr; F: PFileRec);

{ Present the Change Attribute dialog }
procedure ChangeAttr(const Path: FNameStr; F:PFileRec);

{ Allow user to specify what viewer program to use }
procedure InstallViewer;

{ Allow user to specify the display options }
procedure SetDisplayPrefs;

{ Save and load the configuration file }
procedure SaveConfig;
procedure ReadConfig;

{ Execute the passed string literally }
procedure RunDosCommand(Command: String);

{ Return a TFileNameRec built from the passed filespec. This structure }
{ allows for easier comparisons by other procedures                    }
function NewFileNameRec(const Path: FNameStr): PFileNameRec;

{ Perform a drag & drop copy }
procedure DragDropCopy(Mover: PFileMover; Dest: PathStr);

{ return true if this name matches the wildcard }
function WildCardMatch(const Name, Card: FNameStr): Boolean;

const
  StatusMsg : String = '';

implementation

uses ViewHex, ViewText, Strings, Equ, Assoc;

const
  StatusBox : PStatusBox = nil;
  StatusPMsg : PString = @StatusMsg;

  ConfigHeader : TConfigHeader = 'TVFM Configuration File'#26;

{ General utility procedures }

procedure ShowStatusBox;
var
  R: TRect;
  P: PView;
begin
  if StatusBox <> nil then exit;
  R.Assign(0,0,40,5);
  StatusBox := New(PStatusBox, Init(R, 'Status'));
  with StatusBox^ do
  begin
    Options := Options or ofCentered;
    Options := Options and (not ofBuffered);
    Flags := Flags and (not wfClose) and (not wfMove);
    R.Assign(2,2,38,3);
    P := New(PParamText, Init(R, ^C'%s', 1));
    Insert(P);
  end;
  StatusMsg := '';
  StatusPMsg := @StatusMsg;
  StatusBox^.SetData(StatusPMsg);
  Desktop^.Insert(StatusBox);
end;

procedure ShowCopyStatusBox(MaxSize: Longint);
var
  R: TRect;
  P: PView;
begin
  if StatusBox <> nil then exit;
  R.Assign(0,0,40,7);
  StatusBox := New(PStatusBox, Init(R, 'Status'));
  with StatusBox^ do
  begin
    Options := Options or ofCentered;
    Options := Options and (not ofBuffered);
    Flags := Flags and (not wfClose) and (not wfMove);
    R.Assign(2,2,38,3);
    P := New(PParamText, Init(R, ^C'%s', 1));
    Insert(P);
    R.Assign(5,4,34,5);
    Insert(New(PBarGauge, Init(R, MaxSize)));
    R.Assign(2,4,4,5);
    Insert(New(PStaticText, Init(R, '0%')));
    R.Assign(35,4,39,5);
    Insert(New(PStaticText, Init(R, '100%')));
  end;
  StatusMsg := '';
  StatusPMsg := @StatusMsg;
  StatusBox^.SetData(StatusPMsg);
  Desktop^.Insert(StatusBox);
end;

procedure KillStatusBox;
begin
  if StatusBox <> nil then
  begin
    Dispose(StatusBox, Done);
    StatusBox := nil;
  end;
end;

{ Return TRUE if the passed list has tagged files in it }
function HasTaggedFiles(P: PFileList) : Boolean;
var
  Has: Boolean;
  i: Integer;
begin
  Has := False;
  i := 0;
  while (i < P^.Count) and (not Has) do
  begin
    Has := PFileRec(P^.At(i))^.Tagged;
    Inc(i);
  end;
  HasTaggedFiles := Has;
end;

function GetExeBaseName : String;
var
  ExeFileName: FNameStr;
  D: DirStr;
  N: NameStr;
  E: ExtStr;
begin
  ExeFileName := ParamStr(0);
  if ExeFileName = '' then
    ExeFileName := FSearch(EXEName, GetEnv('PATH'));
  ExeFileName := FExpand(ExeFileName);
  FSplit(ExeFileName, D, N, E);
  GetExeBaseName := D + N;
end;

procedure UpperCase(var s:string);
var
  i : Integer;
begin
  for i := 1 to Length(s) do
    s[i] := Upcase(s[i]);
end;

procedure LowerCase(var s:string);
var
  i : Integer;
begin
  for i := 1 to Length(s) do
    if s[i] in ['A'..'Z'] then Inc(s[i], 32);
end;

function RJustNum(L: Longint): String;
var
  s: String;
begin
  FormatStr(s, '%8d', L);
  RJustNum := s;
end;

function Pad(s: String; Len: Byte): String;
begin
  if Length(s) < Len then
    FillChar(s[Succ(Length(s))], Len-Length(s), ' ');
  s[0] := Char(Len);
  Pad := s;
end;

function FullTrim(const Original: String): String;
var
  S: String;
begin
  S := Original;
  while (S[0] > #0) and (S[Length(S)] = #32) do Dec(S[0]);  { trim left }
  while (S[0] > #0) and (S[1] = #32) do
  begin
    Move(S[2], S[1], Pred(Length(S)));
    Dec(S[0]);
  end;
  FullTrim := S;
end;

function TwoDigit(W: Word; Pad: Boolean) : String2;
var
  s: String2;
begin
  Str(W:2, s);
  if Pad and (s[1] = ' ') then s[1] := '0';
  TwoDigit := s;
end;

function FourDigit(W: Word) : String4;
var
  s: String4;
begin
  Str(W:4, s);
  FourDigit := s;
end;

function FormatDateTime(DT: Longint; Opts: Word): String;
var
  s: String;
  t: DateTime;
begin
  UnpackTime(DT, t);
  s := '';
  if (Opts and 1) <> 0 then  { add the date }
  begin
    s := s + TwoDigit(t.Month, False) + '-' + TwoDigit(t.Day, True);
    s := s + '-' + Copy(FourDigit(t.Year),3,2);
  end;
  if (Opts and 2) <> 0 then  { add the time }
  begin
    if s <> '' then s := s + ' ';
    s := s + TwoDigit(t.Hour, True) + ':' + TwoDigit(t.Min, True) + ':' +
      TwoDigit(t.Sec, True);
  end;
  FormatDateTime := s;
end;

function FormatAttr(Attr: Word): String4;
var
  s: String4;
begin
  s := '