utils.pas

一个模拟Delphi的快速开发环境RAD

unit utils;

interface

uses
   SysUtils, WinTypes, WinProcs, Classes, Consts,Dialogs,inifiles,FILECTRL,
   Graphics,Controls,Forms;

type
  EInvalidDest = class(EStreamError);
  EFCantMove = class(EStreamError);
  TFileInfo = record
     Date: longint;
     Size: longint;
  end;

function  GetFileSize(const FileName: string): Longint;
function  FileDateTime(const FileName: string): TDateTime;
function  GetFileInfo(sFile: string): TFileInfo;
function  MsgDlg(const Context,Title:string;TextType:Word):Integer;
function  FormatNumber(l:longint):string;
function  CreateDefaultProject(List:TStringList):TStringList;
// 蜡聪飘 颇老狼 扁夯利牢 内靛甫 累己秦 霖促.
function  CreateDefaultUnit(List:TStringList;const UnitName,FormName:string):TStringList;
// 颇老疙俊辑 犬厘磊甫 力寇茄 鉴荐茄 颇老疙父 倒妨霖促.
function  GetNetFileName(const FileName:string):string;
procedure CreateShowModal(FormClass:TFormClass);
procedure InsertProjectCode(const UnitName,FormName:string);
procedure DeleteProjectCode(const UnitName:string);
function  AppendSlash(Source:string):string;
function  DeleteSlash(Source:string):string;
function  FindItem(List:TStringList;Item:string):Boolean;
procedure SaveFindText(FindText:string);

implementation

uses ShellAPI,uconst;

function GetFileInfo(sFile: string): TFileInfo;
var
 f: file;
 fInfo: ^TFileInfo;
begin

 New(fInfo);

 try

   if not FileExists(sFile) then exit;

   {Set file access mode to readonly in case file is in use.}
   System.FileMode := fmOpenRead;
   {assign and open files}
   AssignFile(f,sFile);
   {$I-}
   Reset(f,1);
   {$I+}
  {Set file access mode back to normal default for other processes}
  System.Filemode := fmOpenReadWrite;
  if IOResult <> 0  then
   begin
    messageDlg(sFile+'甫 凯 荐 绝嚼聪促.',mtWarning,[mbOK],0);
    fInfo^.size := 0;
    fInfo^.date := 0;
   end
  else
   begin
    fInfo^.size := FileSize(f);
    fInfo^.date := FileGetDate(TFileRec(f).Handle);
   end;
  result := fInfo^;
  system.closeFile(f);

 finally
  Dispose(fInfo);
 end;

end;

function GetFileSize(const FileName: string): LongInt;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else Result := 0;
end;

function FileDateTime(const FileName: string): System.TDateTime;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
     Result := FileDateToDateTime(FileAge(FileName))
  else Result:=EncodeDate(1900,1,1);   
end;

function MsgDlg(const Context,Title:string;TextType:Word):Integer;
var
   Msg,Msg1:array [0..70] of char;
   ret:Integer;
begin
    StrPCopy(Msg,Context);
    StrPCopy(Msg1,Title);
    ret:=Application.MessageBox(Msg,Msg1,TextType);
    Result:=ret;
end;

function FormatNumber(l:longint):string;
begin
   FormatNumber:=FormatFloat('#,##0',StrToFloat(IntToStr(l)));
end;

// 货 橇肺璃飘俊 措茄 扁夯 橇肺璃飘 家胶甫 累己茄促.
function CreateDefaultProject(List:TStringList):TStringList;
begin
    List:=TStringList.Create;
    with List do begin
       Add(Format('%s %s;',['program','Project1']));
       Add(' ');
       Add('uses');
       Add(' ');
       Add('  Forms,');
       Add(Format('%s %s',['  Unit1 in','''Unit1.pas'' {Form1};']));
       Add(' ');
       Add('{$R *.RES}');
       Add(' ');
       Add('begin');
       Add('  Application.Initialize;');
       Add('  Application.CreateForm(TForm1,Form1);');
       Add('  Application.Run;');
       Add('end.');
    end;
    Result:=List;
end;

function CreateDefaultUnit(List:TStringList;const UnitName,FormName:string):TStringList;
begin
    List:=TStringList.Create;
    with List do begin
       Add(Format('%s %s;',['unit',UnitName]));
       Add(' ');
       Add('interface');
       Add(' ');
       Add('uses');
       Add('   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;');
       Add(' ');
       Add('type');
       Add(Format('  T%s=class(TForm)',[FormName]));
       Add('  private');
       Add('    { Private declarations }');
       Add('  public');
       Add('    { Public declarations }');
       Add('  end;');
       Add(' ');
       Add('var');
       Add(Format('  %s: T%s;',[FormName,FormName]));
       Add(' ');
       Add('implementation');
       Add(' ');
       Add('{$R *.DFM}');
       Add(' ');
       Add('end.');
    end;
    Result:=List;
end;

function GetNetFileName(const FileName:string):string;
// 颇老疙俊辑 犬厘磊甫 力寇茄 鉴荐茄 颇老疙父 倒妨霖促.
var
   Name:string;
   I:Integer;
begin
   for I:=Length(FileName) downto 1 do
       if FileName[I]='\' then Break;
   // 颇老俊 版肺疙捞 绝绰 版快
   if I=1 then begin
      if Pos('.',FileName)>0 then Name:=Copy(FileName,1,Length(FileName)-I-4)
      else Name:=Copy(FileName,1,Length(FileName));
   end
   // 犬厘磊啊 绝绰 版快
   else if Pos('.',FileName)>0 then Name:=Copy(FileName,I+1,Length(FileName)-I-4)
   else  Name:=Copy(FileName,I+1,Length(FileName)-I);
   Result:=Name;
end;

procedure CreateShowModal(FormClass:TFormClass);
begin
    Screen.Cursor:=crHourGlass;
    with FormClass.Create(Application) do begin
       try
          ShowModal;
       finally
          Free;
       end;
    end;
    Screen.Cursor:=crDefault;
end;

procedure InsertProjectCode(const UnitName,FormName:string);
//橇肺璃飘 家胶俊 货肺款 蜡聪飘甫 眠啊茄促.
var
   I: Integer;
   Temp:string;
begin
    for I:=0 to ProjectInfo.ProjectSource.Count-1 do
    begin
       if Pos('{$R *.RES}',ProjectInfo.ProjectSource[I])>0 then Break;
    end;
    // 付瘤阜 蜡聪飘 急攫俊辑 ';'甫 力芭窍绊 , ','肺 措眉
    Temp:=Copy(ProjectInfo.ProjectSource[I-2],1,Length(ProjectInfo.ProjectSource[I-2])-1);
    ProjectInfo.ProjectSource[I-2]:=Temp+',';
    ProjectInfo.ProjectSource.Insert(I-1,Ident+GetNetFileName(UnitName)+' in '+''''+
        ExtractFileName(UnitName)+''''+' {'+GetNetFileName(FormName)+'};');
end;

procedure DeleteProjectCode(const UnitName:string);
//橇肺璃飘 家胶俊 货肺款 蜡聪飘甫 眠啊茄促.
var
   I: Integer;
   Temp:string;
begin
    for I:=0 to ProjectInfo.ProjectSource.Count-1 do
    begin
       if Pos(UnitName,ProjectInfo.ProjectSource[I])>0 then Break;
    end;
    ProjectInfo.ProjectSource.Delete(I);
end;

// 家胶 巩磊凯捞 '/'肺 救 场唱绰 版快 , /甫 嘿咯霖促.
function  AppendSlash(Source:string):string;
var
  S:string;
begin
    if Source[Length(Source)]<>'\' then S:=Source+'\'
    else S:=Source;
    Result:=S;
end;

// 家胶 巩磊凯捞 '/'肺 场唱绰 版快 , /甫 昏力茄促.
function  DeleteSlash(Source:string):string;
var
  S:string;
begin
    if Source[Length(Source)]<>'\' then S:=Source
    else S:=Copy(Source,1,Length(Source)-1);
    Result:=S;
end;

// List俊 Item捞鄂 亲格捞 乐绰瘤 炼荤茄促.
function FindItem(List:TStringList;Item:string):Boolean;
var
  I:Integer;
begin
   Result:= False;
   for I:=0 to List.Count-1 do
       if List.Values[IntToStr(I)]=Item then begin
          Result:=True;
          Exit;
       end;
end;

// 八祸 巩磊凯阑 ini 颇老俊 历厘茄促.
procedure SaveFindText(FindText:string);
var
   LastNum:Integer;
   List:TStringList;
begin
   List:=TStringList.Create;
   IniFile.ReadSectionValues('FindText',List);
   if List.Count > 0 then
      if FindItem(List,FindText) then Exit;
   LastNum:=IniFile.ReadInteger('FindText','Last',0);
   if LastNum<20 then  begin
      IniFile.WriteInteger('FindText','Last',LastNum+1);
      IniFile.WriteString('FindText',IntToStr(LastNum+1),FindText);
   end
   else  IniFile.WriteInteger('FindText','Last',0);
end;

end.