utils.pas

delphi 写的delphi的程序 Handel is a free, standalone development tool created with Delphi 3 that enable

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 CreateUnit(const UnitName:string):TStringList;
// 蜡聪飘 颇老狼 扁夯利牢 内靛甫 累己秦 霖促.
function  CreateDefaultUnit(List:TStringList;const UnitName,FormName:string):TStringList;
// 颇老疙俊辑 犬厘磊甫 力寇茄 鉴荐茄 颇老疙父 倒妨霖促.
function  GetNetFileName(const FileName:string):string;
procedure CreateShowModal(FormClass:TFormClass);
function  AppendSlash(Source:string):string;
function  DeleteSlash(Source:string):string;
function  FindItem(List:TStringList;Item:string):Boolean;
procedure SaveFindText(FindText:string);
function  BinSearch(S, E: Word; F:string; var R: Word): Boolean;
function  ReplaceStr(const S, Srch, Replace: string): string;
function  NPos(const C: string; S: string; StartPos,Length: Integer): Integer;
function  GetPalettePage:string;
function  GetPalettePageComponent(PalettePage:string):string;
function  GetAllComponentList:string;
procedure ShowKeywordHelp(Keyword:string);
function  FmtLoadNLSStr(Ident: Word; Const Args: Array Of Const): String;
function  GetCommaText(const Text:string; Index:Integer; Comma: Char): string;
function  MakeCommaTextToColor(Text:string; Index:Integer; DefaultColor: TColor): TColor;
function  FileExistOnPath(FileName: string): Boolean;

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 CreateUnit(const UnitName:string):TStringList;
var
  List: TStringList;
begin
    List:=TStringList.Create;
    with List do begin
       Add(Format('%s %s;',['unit',UnitName]));
       Add(' ');
       Add('interface');
       Add(' ');
       Add(' ');
       Add('implementation');
       Add(' ');
       Add(' ');
       Add('end.');
    end;
    Result:=List;
    List:= nil;
    List.Free;
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;

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

// 家胶 巩磊凯捞 '/'肺 场唱绰 版快 , /甫 昏力茄促.
function  DeleteSlash(Source:string):string;
var
  S:string;
begin
   Result:= Source;
   if Source = '' then Exit;
   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;

type
  KeyPtr = ^KeyTable;
  KeyTable = array[1..101] of string;

function BinSearch(S, E: Word; F:string; var R: Word): Boolean;
var
  M: Integer;
  Table1:KeyPtr;
begin
  Table1:= @Keywords;
  F:= UpperCase(F);
  while S < E do
  begin
    M := (S + E) div 2;
    if Table1^[M] < F then
      S := M + 1
    else if Table1^[M] > F then
      E := M - 1
    else
    begin
      S := M;
      E := 0;
    end;
    if M =0 then Break;
  end;
  BinSearch := F = Table1^[S];
  R := S;
end;

// 巩磊凯 S俊辑 Srch 巩磊凯阑 Replace肺 措摹茄促.
function ReplaceStr(const S, Srch, Replace: string): string;
var
  I: Integer;
  Source: string;
begin
  Source := S;
  Result := '';
  repeat
    I := Pos(Srch, Source);
    if I > 0 then begin
      Result := Result + Copy(Source, 1, I - 1) + Replace;
      Source := Copy(Source, I + Length(Srch), MaxInt);
    end
    else Result := Result + Source;
  until I <= 0;
end;

// 巩磊凯S狼 N锅掳 巩磊何磐 Length鳖瘤狼 巩磊凯俊 C巩磊凯捞 乐绰瘤 八荤茄促.
function NPos(const C: string; S: string; StartPos,Length: Integer): Integer;
var
  I: Integer;
  S1:string;
begin
  Result := 0;
  if (S = '') then Exit;
  S1:= Copy(S,StartPos,Length);
  I:=Pos(UpperCase(C),UpperCase(S1));
  if I>0 then Result:= I+StartPos;
end;

function GetPalettePageComponent(PalettePage:string):string;
var
  ComponentNames, ComponentName:string;
  Temp, Pos1:Integer;
  ComponentList:TStringList;
begin
   Result:= '';
   ComponentList:= TStringList.Create;
   ComponentNames:= IniFile.ReadString('Palette',PalettePage, '');
   if ComponentNames = '' then Exit;
   Pos1:= 0;
   Temp:= 1;
   while True do begin
      Pos1:= NPos(';', ComponentNames, Temp, Length(ComponentNames));
      if Pos1 = 0 then Break;
      ComponentName:= Copy(ComponentNames, Temp, Pos1 - Temp -1);
      ComponentList.Add(ComponentName);
      Temp:= Pos1;
   end;
   Result:= ComponentList.Text;
   ComponentList:= nil;
   ComponentList.Free;
end;

// Get palette page names
function GetPalettePage:string;
var
  PaletteList,List:TStringList;
  I:Integer;
  PalettePage:string;
begin
   Result:= '';
   PaletteList:= TStringList.Create;
   List:= TStringList.Create;
   IniFile.ReadSection('Palette',PaletteList);
   if PaletteList.Count <= 0 then Exit;
   for I:=0 to PaletteList.Count - 1 do begin
      PalettePage:= PaletteList[I];
      if PalettePage <> '' then  List.Add(PalettePage);
   end;
   Result:= List.Text;
   PaletteList:= nil;
   PaletteList.Free;
   List:= nil;
   List.Free;
end;

// Get all component list
function GetAllComponentList:string;
var
  PaletteList,List,ComponentList:TStringList;
  I:Integer;
  PalettePage:string;
begin
   ComponentList:= TStringList.Create;
   PaletteList:= TStringList.Create;
   List:= TStringList.Create;
   IniFile.ReadSectionValues('Palette',PaletteList);
   for I:=0 to PaletteList.Count - 1 do begin
      PalettePage:= PaletteList.Names[I];
      if PalettePage <> '' then begin
         List.Text:= GetPalettePageComponent(PalettePage);
         ComponentList.AddStrings(List);
      end;
   end;
   Result:= ComponentList.Text;
   List:= nil;
   List.Free;
   PaletteList:= nil;
   PaletteList.Free;
   ComponentList:= nil;
   ComponentList.Free;
end;

procedure ShowKeywordHelp(Keyword:string);
begin
   Application.HelpCommand(HELP_KEY,longint(KeyWord));
end;

function FmtLoadStr(Ident: Word; Const Args: Array Of Const): String;
begin
  FmtStr(Result, LoadStr(Ident), Args);
end;

function FmtLoadNLSStr(Ident: Word; Const Args: Array Of Const): String;
// 促惫绢甫 困茄 皋技瘤 免仿侩
begin
 // FmtStr(Result, LoadNLSStr(Ident), Args);
end;

function  GetCommaText(const Text:string; Index:Integer; Comma: Char): string;
// Text俊辑 Index锅掳 Comma俊 秦寸窍绰 巩磊凯阑 倒妨霖促.
var
  I, Pos1, Width, Temp, Temp1: Integer;
  S: string;
begin
   Result:= Text;
   if Text = '' then Exit;
   S:= Text;
   Pos1:= 0;
   for I:= 0 to Index do
   begin
       Temp:= Pos(Comma, S);
       if Temp = 0 then Break;
       Temp1:= Pos1;
       Pos1:= Pos1 + Temp;
       S:= Copy(Text, Pos1 + 1, Length(S));
   end;
   Width:= Pos1 - Temp1 -1;
   Result:= Trim(Copy(Text, Temp1 + 1, Width));
end;

function MakeCommaTextToColor(Text:string; Index:Integer; DefaultColor: TColor): TColor;
var
   S: string;
begin
   Result:= DefaultColor;
   if Text = '' then Exit;
   S:= GetCommaText(Text, Index, ',');
   Result:= StrToInt(S);
end;

function  FileExistOnPath(FileName: string): Boolean;
var
   Path: string;
begin
   Result:= True;
   Path:= ExtractFilePath(FileName);
   if (Path = '') or (not FileExists(FileName)) then Result:= False;
end;

end.