utilsdos.pas

这是一个有关文本编辑器的源程序,支持彩色语法,你可以任意修改,修改后发给我一份

unit UtilsDos;

interface

uses
	WinProcs, WinTypes, SysUtils, Classes;

type
	TByteFile = file of Byte;
	TDrive    = 'A'..'Z';
	TDrives   = set of TDrive;

function UCase (NormalChar: Char): Char;
function LCase (NormalChar: Char): Char;
function IsNormalChar (Ch: Char): Boolean;
function ChangeText (var ChText: string; ToChange, ToInsert: string): Byte;
function LastPos (const Substr, S: string): Integer;
function FirstNonWhiteSpace (const S: string): Integer;

function GetDriveDescription (Drive: TDrive): string;
function DiskInDrive (Drive: TDrive): Boolean;
function FileExistsWithCase (const FileName: string): Boolean;
function DirExists (const Directory: string): Boolean;
function DirExistsWithCase (const Directory: string): Boolean;
function GetFileSize (const FileName: string): Integer;
function GetSubDir (const Directory: string): string;
function GetHigherDir (const Directory: string): string;
function GetLowerName (const N: string): string;
function SizeToStr (Size: Int64): string;
function AttrToStr (Attr: Integer): string;
procedure CreatePath (const Directory: string);
procedure DelTree (const Directory: string);
procedure DelAllFiles (const Directory: string);

procedure PCSpeakerPlay (Frequency: Word);
procedure PCSpeakerStop;

procedure SetDate (a: Word; m, d: Byte);
procedure SetTime (h, m, s, hs: Byte);

procedure WrCStr (var F: TByteFile; Str: string);
procedure WrPStr (var F: TByteFile; Str: string; Len: Byte);
procedure WrVStr (var F: TByteFile; Str: string);
procedure WrSInt (var F: TByteFile; Value: ShortInt);
procedure WrByte (var F: TByteFile; Value: Byte);
procedure WrNInt (var F: TByteFile; Value: SmallInt);
procedure WrWord (var F: TByteFile; Value: Word);
procedure RdCStr (var F: TByteFile; var Str: string; Len: Byte);
procedure RdPStr (var F: TByteFile; var Str: string; Len: Byte);
procedure RdVStr (var F: TByteFile; var Str: string);
procedure RdSInt (var F: TByteFile; var Value: ShortInt);
procedure RdByte (var F: TByteFile; var Value: Byte);
procedure RdNInt (var F: TByteFile; var Value: SmallInt);
procedure RdWord (var F: TByteFile; var Value: Word);

type
	TFileAttribute = (atDirectory, atArchive, atReadOnly, atHidden, atSystem);
	// atDirectory only for internal use and property request
	TFileAttributes = set of TFileAttribute;

const
	atStd: TFileAttributes = [atArchive, atReadOnly];
	atAll: TFileAttributes = [atArchive, atReadOnly, atHidden, atSystem];

type
	TFileReferences = class;

	TFileReference = class(TPersistent)
	private
		FOwner: TFileReferences;
		FSearchRec: TSearchRec;
		function GetCreationTime: TDateTime;
		function GetFileAttr: TFileAttributes;
		function GetFileName: string;
		function GetFileSize: Integer;
		function GetFullName: string;
		function GetFullShortName: string;
		function GetLastAccessTime: TDateTime;
		function GetModificationTime: TDateTime;
		function GetShortFileName: string;
	public
	published
		property Owner: TFileReferences read FOwner;
		property RecData: TSearchRec read FSearchRec;
		property FullName: string read GetFullName;
		property FileName: string read GetFileName;
		property FullShortName: string read GetFullShortName;
		property ShortFileName: string read GetShortFileName;
		property CreationTime: TDateTime read GetCreationTime;
		property ModificationTime: TDateTime read GetModificationTime;
		property LastAccessTime: TDateTime read GetLastAccessTime;
		property FileSize: Integer read GetFileSize;
		property FileAttr: TFileAttributes read GetFileAttr;
	end;

	TFileReferences = class(TPersistent)
	private
		FList: TList;
		FDirectory: string;
		FWildCard: string;
		FSearchAttr: TFileAttributes;
		FSearchTime: TDateTime;
		function GetItem(ItemIndex: Integer): TFileReference;
		function GetCount: Integer;
	public
		constructor Create;
		destructor Destroy; override;
		function Add(const F: TSearchRec): Integer; virtual;
		procedure Delete(Index: Integer); virtual;
		procedure Clear;
		procedure SearchForFiles(FileName: string; FileAttr: TFileAttributes);
		procedure SearchForDirs(const ParentDir: string; FileAttr: TFileAttributes);
		procedure CopyToStrings(const S: TStrings);
		procedure CopyFullNamesToStrings(const S: TStrings);
		property Items[ItemIndex: Integer]: TFileReference read GetItem;
		property Count: Integer read GetCount;
	published
		property Directory: string read FDirectory;
		property WildCard: string read FWildCard;
		property SearchAttr: TFileAttributes read FSearchAttr;
		property SearchTime: TDateTime read FSearchTime;
	end;

function WinFileTimeToDateTime(WinFileTime: TFileTime): TDateTime;
function WinFileAttrToFileAttr(WinFileAttr: Integer): TFileAttributes;
function FileAttrToWinFileAttr(FileAttr: TFileAttributes): Integer;

procedure AddBackslash(var Dir: string);
function WithBackslash(const Dir: string): string;
function WithoutBackslash(const Dir: string): string;
function WithoutExt(const FileName: string): string;

implementation

function UCase;
begin
	Result := UpCase (NormalChar);
	case Result of
		'