Delphi公共函數（一）

//摘自Kendy's Blog
{

使用方法, uses 本單元——>使用如:Pub.MsgBox('你好，歡迎使用本公用函數！');
ShowMessage(Pub.PathExeDir);
}
//////////////////////以下源碼開始
{$DEFINE Delphi7}//D5下不要此句
unit PubFuncUnit;

interface

uses Windows, SysUtils, ShellAPI, Messages, Classes, Forms, Controls, ComCtrls,
     Dialogs, Graphics, Registry, winsock, ComObj, WinInet,FileCtrl
     {$IFDEF Delphi7},Variants{$EndIf};
const
DEFAULT_DELIMITERS = [' ', #9, #10, #13];//空格分隔
type
TMyClass = class
private
    procedure CleanDirectoryProc(sFileName: string; var bContinue: Boolean);
end;
TEnumDirectoryFileProc = procedure (Filename: string; var bContinue: Boolean) of object;
type
TPub = class
private
    procedure ProcessTimer1Timer(Sender: TObject);
public
    //封裝API ShellExecute// 0:隱含窗口，1:顯示窗口....其他參考幫助
    function MyShellExecute(const sFileName: string; sPara: string= ''; sAction :string = 'Open';
       flag: integer = 1): LongInt;
    //在進程中運行//如：Pub.Execute('C:/WINNT/system32/net.exe send huo aa',true,true,nil);
    function MyExecute(const Command: string; bWaitExecute: Boolean;
       bShowWindow: Boolean; PI: PProcessInformation): Boolean;

    //文件操作部分起
    //拷貝一個文件，封裝CopyFile
    procedure FileCopyFile(const sSrcFile, sDstFile: string);
    //給定路徑複製文件到同一目錄下 bRecursive:true所有
    procedure FileCopyDirectory(sDir, tDir: string; bRecursive: Boolean);overload;
    //給定路徑原樣複製文件 ,自編
    procedure FileCopyDirectory(sDir, tDir: string);overload;
    //給定路徑原樣複製文件，用WinAPI ,若原目錄下有相同文件則再生成一個
    procedure FileCopyDirectory(sDir, tDir:string;AHandle:Thandle);overload;
    //移動文件夾
    procedure FileMoveDirectory(sDir, tDir:string;AHandle:Thandle);
    //刪除給定路徑及以下的所有路徑和文件
    procedure FileDeleteDirectory(sDir: string);overload;
    //刪除給定路徑及以下的所有路徑和文件用WinApi
    procedure FileDeleteDirectory(AHandle: THandle;const ADirName: string);overload;
    //刪除給定路徑及以下的所有路徑和文件到回收站
    procedure FileDeleteDirectoryToCycle(AHandle: THandle;const ADirName: string);
    //取得指定文件的大小
    function FileGetFileSize(const Filename: string): DWORD;
    //在Path下取得唯一FilenameX文件
    function FileGetUniqueFileName(const Path: string; Filename: string): string;
    //取得臨時文件
    function FileGetTemporaryFileName: string;

    //取得系統路徑
    function PathGetSystemPath: string;
    //取得Windows路徑
    function PathGetWindowsPath: string;
    //給定文件名取得在系統目錄下的路徑，複製時用
    function PathSystemDirFile(const Filename: string): string;
    //給定文件名取得在Windows目錄下的路徑，複製時用
    function PathWindowsDirFile(const Filename: string): string;
    //給定文件名取得在系統盤下的路徑，複製時用
    function PathSystemDriveFile(const Filename: string): string;
    //路徑最後有'/'則去'/'
    function PathWithoutSlash(const Path: string): string;
    //路徑最後沒有'/'則加'/'
    function PathWithSlash(const Path: string): string;
    //取得兩路徑的不同部分，條件是前半部分相同
    function PathRelativePath(BaseDir, FilePath: string): string;
    //取得去掉屬性的路徑，文件名也作爲DIR
    function PathExtractFileNameNoExt(Filename: string): string;
    //判斷兩路徑是否相等
    function PathComparePath(const Path1, Path2: string): Boolean;
    //取得給定路徑的父路徑
    function PathParentDirectory(Path: string): string;
    //分割路徑，Result=根(如d:)sPath = 除根外的其他部分
    function PathGetRootDir(var sPath: string): string;
    //取得路徑最後部分和其他部分如d:/aa/aa result:=aa sPath:=d:/aa/
    function PathGetLeafDir(var sPath: string): string;
    //取得當前應用程序的路徑
    function PathExeDir(FileName: string = ''): string;
    //文件操作部分止

    //系統處理起
    //提示窗口
    procedure MsgBox(const Msg: string);
    //錯誤顯示窗口
    procedure MsgErrBox(const Msg: string);
    //詢問窗口帶'是','否'按鈕
    function MsgYesNoBox(const Msg: string): Boolean;
    //詢問窗口帶'是','否,'取消'按鈕//返回值smbYes,smbNo,smbCancel
    function MsgYesNoCancelBox(const Msg: string): Integer;
    //使鼠標變忙和恢復正常
    procedure DoBusy(Busy: Boolean);
    //顯示錯誤信息
    procedure ShowLastError(const Msg: string = 'API Error');
    //發出錯誤信息
    procedure RaiseLastError(const Msg: string = 'API Error');
    //釋放Strings連接的相關資源
    procedure FreeStringsObjects(SL: TStrings);
    //系統處理止

    //時間處理起
    //整數到時間
    function TimeT_To_DateTime(TimeT: Longint): TDateTime;
    //轉化爲秒
    function TimeToSecond(const H, M, S: Integer): Integer;
    //秒轉化
    procedure TimeSecondToTime(const secs: Integer; var H, M, S: Word);
    //秒轉化
    function TimeSecondToTimeStr(secs: Integer): string;
    //時間處理止

    //控件處理起
    //設置控件是否能使用
    procedure ConEnableControl(AControl: TControl; Enable: Boolean);
    //設置控件是否能使用，包子控件
    procedure ConEnableChildControls(AControl: TControl; Enable: Boolean);
    procedure ConEnableClassControl(AControl: TControl; Enable: Boolean;
      ControlClass: TControlClass);
    procedure ConFree(aCon: TWinControl);//釋放aCon上的控件
    //從文件本中導入,類似LoadfromFile
    procedure ConLoadTreeViewFromTextFile(Nodes: TTreeNodes; Filename: string);
    //存爲文本,類似SaveToFile
    procedure ConSaveTreeViewToTextFile(Nodes: TTreeNodes; Filename: string);
    //在控件上寫文本
    procedure ConWriteText(aContr: TControl;sText: string);
    //控件處理止

//字符串處理起
    //取以Delimiters分隔的字符串 bTrail如果爲True則把第index個後的也取出來
    function StrGetToken(const S: string; index: Integer;
       bTrail: Boolean = False;
       Delimiters: TSysCharSet = DEFAULT_DELIMITERS): string;
    //取以Delimiters分隔的字符串的個數
    function StrCountWords(S: string; Delimiters: TSysCharSet =
       DEFAULT_DELIMITERS): Integer;
    //用NewToken替換S中所有Token bCaseSensitive:=true大小寫敏感
    function StrReplaceString(var S: string; const Token,
       NewToken: string; bCaseSensitive: Boolean): Boolean;
    //從第Index個起以Substr替換Count個字符
    procedure StrSimple_ReplaceString(var S: string;
       const Substr: string; index, Count: Integer);
    //去掉S中的回車返行符
    procedure StrTruncateCRLF(var S: string);
    //判定S是否以回車返行符結束
    function StrIsContainingCRLF(const S: string): Boolean;
    //把SL中的各項數據轉化爲以Delimiter分隔的Str
    function StrCompositeStrings(SL: TStrings; const Delimiter: string): string;
    //封裝TStrings的LoadFromFile
    function StrSafeLoadStrings(SL: TStrings; const Filename: string): Boolean;
    //封裝TStrings的SaveToFile
    procedure StrSafeSaveStrings(SL: TStrings; const Filename: string);
    //字符串處理止

    //字體處理起
    procedure StringToFont(sFont: string; Font: TFont; bIncludeColor: Boolean = True);
    function FontToString(Font: TFont; bIncludeColor: Boolean = True): string;
    //字體處理止

    //網絡起
    //判定是否在線
    function NetJudgeOnline:boolean;
    //得到本機的局域網Ip地址
    Function NetGetLocalIp(var LocalIp:string): Boolean;
    //通過Ip返回機器名
    Function NetGetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;
    //獲取網絡中SQLServer列表
    Function NetGetSQLServerList(var List: Tstringlist): Boolean;
    //獲取網絡中的所有網絡類型
    Function NetGetNetList(var List: Tstringlist): Boolean;
    //獲取網絡中的工作組
    Function NetGetGroupList(var List: TStringList): Boolean;
    //獲取工作組中所有計算機
    Function NetGetUsers(GroupName: string; var List: TStringList): Boolean;
    //獲取網絡中的資源
    Function NetGetUserResource(IpAddr: string; var List: TStringList): Boolean;
    //映射網絡驅動器
    Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean;
    //檢測網絡狀態
    Function NetCheckNet(IpAddr:string): Boolean;
    //檢測機器是否登入網絡
    Function NetCheckMacAttachNet: Boolean;
    //判斷Ip協議有沒有安裝   這個函數有問題
    Function NetIsIPInstalled : boolean;
    //檢測機器是否上網
    Function NetInternetConnected: Boolean;
    //網絡止

    //窗口起
    function FormCreateProcessFrm(MsgTitle: string):TForm;
    //窗口止

    //EMail起
    function CheckMailAddress(Text: string): boolean;
    //EMail止
end;

var
Pub: TPub;

implementation
uses ExtCtrls, StdCtrls, TFlatProgressBarUnit;
{ TMyClass }

const
csfsBold      = '|Bold';
csfsItalic    = '|Italic';
csfsUnderline = '|Underline';
csfsStrikeout = '|Strikeout';
C_Err_GetLocalIp       = '獲取本地ip失敗';
C_Err_GetNameByIpAddr = '獲取主機名失敗';
C_Err_GetSQLServerList = '獲取SQLServer服務器失敗';
C_Err_GetUserResource = '獲取共享資失敗';
C_Err_GetGroupList     = '獲取所有工作組失敗';
C_Err_GetGroupUsers    = '獲取工作組中所有計算機失敗';
C_Err_GetNetList       = '獲取所有網絡類型失敗';
C_Err_CheckNet         = '網絡不通';
C_Err_CheckAttachNet   = '未登入網絡';
C_Err_InternetConnected ='沒有上網';
C_Txt_CheckNetSuccess = '網絡暢通';
C_Txt_CheckAttachNetSuccess = '已登入網絡';
C_Txt_InternetConnected ='上網了';

procedure TMyClass.CleanDirectoryProc(sFileName: string; var bContinue: Boolean);
var
Attr: Integer;
begin
Attr := FileGetAttr(sFileName);
Attr := (not faReadOnly) and Attr; // Turn off ReadOnly attribute
Attr := (not faHidden) and Attr; // Turn off Hidden attribute
FileSetAttr(sFileName, Attr);

if Attr and faDirectory <> 0 then
RMDir(sFileName)
else
SysUtils.DeleteFile(sFileName);
end;

{ TPub }

function TPub.PathWithoutSlash(const Path: string): string;
begin
if (Length(Path) > 0) and (Path[Length(Path)] = '/') then Result := Copy(Path, 1, Length(Path) - 1)
else Result := Path;
end;

function TPub.PathWithSlash(const Path: string): string;
begin
Result := Path;
if (Length(Result) > 0) and (Result[Length(Result)] <> '/') then Result := Result + '/';
end;

function TPub.PathRelativePath(BaseDir, FilePath: string): string;
begin
Result := FilePath;
BaseDir := AnsiUpperCaseFileName(PathWithSlash(BaseDir));
FilePath := AnsiUpperCaseFileName(FilePath);
if Copy(FilePath, 1, Length(BaseDir)) = BaseDir then
Delete(Result, 1, Length(BaseDir));
end;

function TPub.MyShellExecute(const sFileName: string; sPara: string= ''; sAction :string = 'Open';
flag: integer = 1): LongInt;
begin
Result := ShellExecute(Application.Handle, PChar(sAction), PChar(sFileName), PChar(sPara), PChar(''), flag);// > 32;
if Result < 33 then RaiseLastError('ShellExecute');
end;

function TPub.MyExecute(const Command: string; bWaitExecute: Boolean; bShowWindow: Boolean; PI: PProcessInformation): Boolean;
var
StartupInfo       : TStartupInfo;
ProcessInformation: TProcessInformation;
begin
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
with StartupInfo do
begin
    cb := SizeOf(TStartupInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    if bShowWindow then
      wShowWindow := SW_NORMAL
    else
      wShowWindow := SW_HIDE;
end;

Result := CreateProcess(nil, PChar(Command),
nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil,
StartupInfo, ProcessInformation);

if not Result then Exit;

if bWaitExecute then
WaitForSingleObject(ProcessInformation.hProcess, INFINITE);

if Assigned(PI) then
Move(ProcessInformation, PI^, SizeOf(ProcessInformation));
end;

function TPub.PathExtractFileNameNoExt(Filename: string): string;
begin
Result := Copy(Filename, 1, Length(Filename) - Length(ExtractFileExt(Filename)));
end;

function TPub.FileGetFileSize(const Filename: string): DWORD;
var
HFILE: THandle;
begin
HFILE := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if HFILE <> INVALID_HANDLE_VALUE then
begin
    Result := GetFileSize(HFILE, nil);
    CloseHandle(HFILE);
end else
    Result := 0;
end;

procedure TPub.FileCopyFile(const sSrcFile, sDstFile: string);
begin
if AnsiCompareFileName(sSrcFile, sDstFile) <> 0 then
CopyFile(PChar(sSrcFile), PChar(sDstFile), False);
end;

function TPub.FileGetTemporaryFileName: string;
var
Buf, Buf1: array[0..255] of Char;
begin
GetTempPath(255, @Buf);
GetTempFileName(@Buf, 'xpd', 0, @Buf1);
Result := StrPas(@Buf1);
end;

function TruncateTrailNumber(var S: string): Integer;//取得逗號分開的兩數，後數據必爲合法整數222,333 s := 222 result := 333
var
I: Integer;
begin
Result := -1;

I := Pos(',', S);
if I <> 0 then
begin
Result := StrToIntDef(Copy(S, I + 1, Length(S)), - 1);
Delete(S, I, Length(S));
end;
end;

function TruncateTrailIfNotDLL(S: string): string;
begin
Result := S;
TruncateTrailNumber(S);

if (CompareText(ExtractFileExt(S), '.DLL') <> 0) and
(CompareText(ExtractFileExt(S), '.ICL') <> 0) and
(CompareText(ExtractFileExt(S), '.EXE') <> 0) then Result := S;
end;

function TPub.PathParentDirectory(Path: string): string;
var
iLastAntiSlash: Integer;

function CountAntiSlash: Integer;
var
    I: Integer;
begin
    Result := 0;
    I := 1;
    repeat
      if IsDBCSLeadByte(Ord(Path[I])) then
        Inc(I, 2)
      else
      begin
        if Path[I] = '/' then
        begin
          iLastAntiSlash := I;
          Inc(Result);
        end;
        Inc(I);
      end;
    until I > Length(Path);
end;

function UpOneDirectory: string;
begin
Result := Copy(Path, 1, iLastAntiSlash); // with slash
end;

begin
// 'c:/windows/system/' => 'c:/window/'
// 'f:/' => 'f:/'
// '//xshadow/f/fonts' => '//xshadow/f/'
// '//xshadow/f/' => '//xshadow/f/'
Path := PathWithoutSlash(Path);

if Length(Path) > 3 then
begin
    if (Path[1] = '/') and (Path[2] = '/') then
    begin
      if CountAntiSlash > 3 then
        Result := UpOneDirectory;
    end else
    begin
      if CountAntiSlash > 1 then
        Result := UpOneDirectory;
    end;
end else Result := Path;
end;

function TPub.PathSystemDirFile(const Filename: string): string;
var
Buf: array[0..255] of Char;
begin
GetSystemDirectory(@Buf, 255);
Result := PathWithSlash(StrPas(@Buf)) + Filename;
end;

function TPub.PathWindowsDirFile(const Filename: string): string;
var
Buf: array[0..255] of Char;
begin
GetWindowsDirectory(@Buf, 255);
Result := PathWithSlash(StrPas(@Buf)) + Filename;
end;

function TPub.PathSystemDriveFile(const Filename: string): string;
var
Buf: array[0..255] of Char;
begin
GetSystemDirectory(@Buf, 255);
Result := PathWithSlash(ExtractFileDrive(StrPas(@Buf))) + Filename;
end;

function TPub.PathComparePath(const Path1, Path2: string): Boolean;
begin
Result := AnsiCompareFileName(PathWithoutSlash(Path1), PathWithoutSlash(Path2)) = 0;
end;
procedure EnumDirectoryFiles(sDir, SMASK: string; Attr: Integer; EnumDirectoryFileProc: TEnumDirectoryFileProc);
var
SearchRec: TSearchRec;
Status : Integer;
bContinue: Boolean;
begin
sDir := Pub.PathWithSlash(sDir);

// traverse child directories
Status := FindFirst(sDir + '*.*', faDirectory, SearchRec);
try
    while Status = 0 do
    begin
      if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
        EnumDirectoryFiles(sDir + SearchRec.name, SMASK, Attr, EnumDirectoryFileProc);

      Status := FindNext(SearchRec);
    end;
finally
    SysUtils.FindClose(SearchRec);
end;

// exam each valid file and invoke the callback func
Status := FindFirst(sDir + SMASK, faAnyFile, SearchRec);
try
    while Status = 0 do
    begin
      if (SearchRec.Attr and Attr <> 0) and (FileExists(sDir + SearchRec.name) or DirectoryExists(sDir + SearchRec.name)) and
        not ((SearchRec.Attr and faDirectory <> 0) and ((SearchRec.name = '.') or (SearchRec.name = '..'))) then
      begin
        bContinue := True;
        EnumDirectoryFileProc(sDir + SearchRec.name, bContinue);
        if not bContinue then Break;
      end;

      Status := FindNext(SearchRec);
    end;
finally
    SysUtils.FindClose(SearchRec);
end;
end;

procedure TPub.FileDeleteDirectory(sDir: string);
begin
//if not MsgYesNoBox('確信要刪除該目錄及以下所有文件夾和文件嗎？') then exit;
with TMyClass.Create do
    try
      EnumDirectoryFiles(sDir, '*.*', faAnyFile, CleanDirectoryProc);
    finally
      Free;
    end;
RMDir(sDir);
end;

procedure TPub.FileDeleteDirectory(AHandle: THandle;const ADirName: string);
var
SHFileOpStruct:TSHFileOpStruct;
DirName: PChar;
BufferSize: Cardinal;
begin
// 調用shFileOperation函數可以實現對目錄的拷貝、移動、重命名或刪除操作
BufferSize := length(ADirName) + 2;
GetMem(DirName,BufferSize);
try
    FIllChar(DirName^, BufferSize, 0);
    StrCopy(DirName,PChar(ADirName));
    with SHFileOpStruct do
    begin
      Wnd := AHandle;
      WFunc := FO_DELETE;
      pFrom := DirName;
      pTO := nil;
      fFlags := FOF_ALLOWUNDO;

      fAnyOperationsAborted := false;
      hNameMappings := nil;
      lpszProgressTitle := nil;
    end;
    if SHFileOperation(SHFileOpStruct) <> 0 then
      Raiselastwin32Error;
finally
    FreeMem(DirName,BufferSize);
end;
end;

procedure TPub.FileDeleteDirectoryToCycle(AHandle: THandle;const ADirName: string);
var
SHFileOpStruct:TSHFileOpStruct;
DirName: PChar;
BufferSize: Cardinal;
aa: string;
begin
// 調用shFileOperation函數可以實現對目錄的拷貝、移動、重命名或刪除操作
if not DirectoryExists(ADirName) then
begin
    aa := ADirName;
    MsgBox('不存在文件夾“' + PathGetLeafDir(aa) + '”,刪除失敗！');
    exit;
end;
BufferSize := length(ADirName) + 2;
GetMem(DirName,BufferSize);
try
    FIllChar(DirName^, BufferSize, 0);
    StrCopy(DirName,PChar(ADirName));
    with SHFileOpStruct do
    begin
      Wnd := AHandle;
      WFunc := FO_DELETE;
      pFrom := DirName;
      pTO := nil;
      fFlags := FOF_ALLOWUNDO;

      fAnyOperationsAborted:=false;
      hNameMappings:=nil;
      lpszProgressTitle:=nil;
    end;
    if SHFileOperation(SHFileOpStruct) <> 0 then
      Raiselastwin32Error;
finally
    FreeMem(DirName,BufferSize);
end;
end;

procedure TPub.FileCopyDirectory(sDir, tDir: string; bRecursive: Boolean);
var
SearchRec: TSearchRec;
Status : Integer;
begin
sDir := PathWithSlash(sDir);
tDir := PathWithSlash(tDir);

Status := FindFirst(sDir + '*.*', faAnyFile, SearchRec);
try
    while Status = 0 do
    begin
      if bRecursive and (SearchRec.Attr and faDirectory = faDirectory) then
      begin
        if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
          FileCopyDirectory(sDir + SearchRec.name, tDir, bRecursive);
      end else FileCopyFile(sDir + SearchRec.name, tDir + SearchRec.name);

      Status := FindNext(SearchRec);
    end;
finally
    SysUtils.FindClose(SearchRec);
end;
end;

function TPub.FileGetUniqueFileName(const Path: string; Filename: string): string;
var
I : Integer;
sExt: string;
begin
Result := Filename;

sExt := ExtractFileExt(Filename);
Filename := PathExtractFileNameNoExt(Filename);

I := 1;
repeat
if not FileExists(PathWithSlash(Path) + Result) then Break;

Result := Filename + IntToStr(I) + sExt;
Inc(I);
until False;

Result := PathWithSlash(Path) + Filename + sExt;
end;

function TPub.PathGetSystemPath: string;
var
Buf: array[0..255] of Char;
begin
GetSystemDirectory(@Buf, 255);
Result := PathWithSlash(StrPas(@Buf));
end;

function TPub.PathGetWindowsPath: string;
var
Buf: array[0..255] of Char;
begin
GetWindowsDirectory(@Buf, 255);
Result := PathWithSlash(StrPas(@Buf));
end;

function TPub.PathGetRootDir(var sPath: string): string;
var
I: Integer;
begin
I := AnsiPos('/', sPath);
if I <> 0 then
Result := Copy(sPath, 1, I)
else
Result := sPath;

Delete(sPath, 1, Length(Result));
Result := PathWithoutSlash(Result);
end;

function TPub.PathGetLeafDir(var sPath: string): string;
begin
sPath := PathWithoutSlash(sPath);
Result := ExtractFileName(sPath);
sPath := ExtractFilePath(sPath);
end;

//系統部分
procedure TPub.MsgBox(const Msg: string);
begin
Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONINFORMATION);
end;

procedure TPub.MsgErrBox(const Msg: string);
begin
Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONERROR);
end;

function TPub.MsgYesNoBox(const Msg: string): Boolean;
begin
Result := Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONQUESTION or
MB_YESNO or MB_DEFBUTTON1) = IDYES;
end;

function TPub.MsgYesNoCancelBox(const Msg: string): Integer;
begin
Result := Application.MessageBox(PChar(Msg),
PChar(Application.Title), MB_ICONQUESTION or MB_YESNOCANCEL or MB_DEFBUTTON1)
end;

procedure TPub.DoBusy(Busy: Boolean);
var
Times: Integer;
begin
Times := 0;
if Busy then
begin
    Inc(Times);
    if Times = 1 then Screen.Cursor := crHourGlass;
end else
begin
    dec(Times);
    if Times = 0 then Screen.Cursor := crDefault;
end;
end;

function GetLastErrorStr: string;
var
Buf: PChar;
begin
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
    nil, GetLastError, LANG_USER_DEFAULT, @Buf, 0, nil);
try
    Result := StrPas(Buf);
finally
    LocalFree(HLOCAL(Buf));
end;
end;

procedure TPub.ShowLastError(const Msg: string = 'API Error');
begin
MsgBox(Msg + ': ' + GetLastErrorStr);
end;

procedure TPub.RaiseLastError(const Msg: string = 'API Error');
begin
raise Exception.Create(Msg + ': ' + GetLastErrorStr);
end;

procedure TPub.FreeStringsObjects(SL: TStrings);
var
I: Integer;
begin
for I := 0 to SL.count - 1 do
    if assigned(SL.objects[I]) then
    begin
      Dispose(pointer(SL.objects[I]));
      SL.objects[I] := nil;
    end;
end;
//以下時間
function TPub.TimeT_To_DateTime(TimeT: Longint): TDateTime;
var
ts: TTimeStamp;
begin
Dec(TimeT, 3600 * 8);    // still unprecise
ts.Time := (TimeT mod 86400) * 1000;
ts.Date := TimeT div 86400 + 719163;
Result := TimeStampToDateTime(ts);
end;

function TPub.TimeToSecond(const H, M, S: Integer): Integer;
begin
Result := H * 3600 + M * 60 + S;
end;

procedure TPub.TimeSecondToTime(const secs: Integer; var H, M, S: Word);
begin
H := secs div 3600;
M := (secs mod 3600) div 60;
S := secs mod 60;
end;

function TPub.TimeSecondToTimeStr(secs: Integer): string;
var
H, M, S: Word;
begin
TimeSecondtotime(secs, h, m, s);

result := '';
if h <> 0 then Result := result + format('%-.2d  ', [h]);
if m <> 0 then Result := result + format('%-.2d だ ', [m]);
if s <> 0 then Result := result + format('%-.2d  ', [s]);
end;

//以下控件
procedure TPub.ConEnableControl(AControl: TControl; Enable: Boolean);
var
I: Integer;
begin
AControl.Enabled := Enable;
if AControl is TWinControl then
    with TWinControl(AControl) do
    begin
      for I := 0 to ControlCount - 1 do
        ConEnableControl(Controls[I], Enable);
    end;
end;

procedure TPub.ConEnableChildControls(AControl: TControl; Enable: Boolean);
var
I: Integer;
begin
if AControl is TWinControl then
    with TWinControl(AControl) do
    begin
      for I := 0 to ControlCount - 1 do
        ConEnableControl(Controls[I], Enable);
    end;
end;

procedure TPub.ConEnableClassControl(AControl: TControl; Enable: Boolean; ControlClass: TControlClass);
var
I: Integer;
begin
if (AControl is ControlClass) then AControl.Enabled := Enable;

if AControl is TWinControl then
    with TWinControl(AControl) do
    begin
      for I := 0 to ControlCount - 1 do
        ConEnableClassControl(Controls[I], Enable, ControlClass);
    end;
end;

function ParseRPLNo(var Msg: string): Integer;
var
S: string;
begin
S := Pub.StrGetToken(Msg, 1,False );
Result := StrToIntDef(S, 0);
Msg := Pub.StrGetToken(Msg, 2,True );
end;

procedure TPub.ConLoadTreeViewFromTextFile(Nodes: TTreeNodes; Filename: string);
var
F: TextFile;

function ProcessNode(Node: TTreeNode; LevelNo: Integer): TTreeNode;
var
    S : string;
    No: Integer;
begin
    Result := Node;
    repeat
      readln(F, S);
      No := ParseRPLNo(S);
      if No > LevelNo then
      begin
        Node := ProcessNode(Nodes.addchild(Node, S), No);
      end else if No < LevelNo then
      begin
        Result := Nodes.Add(Node.Parent, S);
        Exit;
      end else
        Node := Nodes.Add(Node, S);

until EOF(F);
end;

begin
Assignfile(F, Filename);
reset(F);

ProcessNode(nil, 1);

CloseFile(F);
end;