Delphi 常用函数记录

//判断是否是数字function IsNumeric(sDestStr: string): Boolean;//简写多余汉字function SimplifyWord(sWord: string; iMaxLen: Integer): string;//读写取注册表中的字符串值function ReadRegStr(sDWName, KeyName: string; SvrBZ: TSvrOrClient; DefaultValue: string = ''): string;procedure WriteRegStr(sDWName, KeyName, KeyValue: string; SvrBZ: TSvrOrClient;const isExpand : boolean = false);//取本机机器名function GetComputerName: string;//显示消息框procedure InfMsg(const hHandle: HWND; const sMsg: string);procedure ClmMsg(const hHandle: HWND; const sMsg: string);procedure ErrMsg(const hHandle: HWND; const sMsg: string);function ConfirmMsg(const hHandle: HWND; const sMsg: string): Boolean;//检查驱动器类型是否是CDROMfunction CheckCDRom(sPath: string): Boolean;//检查驱动器是否存在function CheckDriver(sPath: string): Boolean;//获得windows临时目录function GetWinTempDir: string;//取系统目录function GetSystemDir: string;//等待执行Winexefunction WinExecAndWait32(Path: PChar; Visibility: Word; Timeout: DWORD): integer;//在所有子目录中查找文件function SearchFiles(DirName: string; //启始目录  Files: TStrings; //输出字符串列表  FileName: string = '*.*'; //文件名  Attr: Integer = faAnyFile; //文件属性  FullFileName: Boolean = True; //是否返回完整的文件名  IncludeNormalFiles: Boolean = True; //是否包括Normal属性的文件  IncludeSubDir: Boolean = True): Boolean; //是否在下级目录中查找//查找所有子目录function SearchDirs(DirName: string;  Dirs: TStrings;  FullFileName: Boolean = True; //是否返回完整的文件名  IncludeSubDir: Boolean = True): Boolean; //是否在下级目录中查找//删除所有文件夹和文件procedure DeleteTree(sDir: string);//删除文件的只读属性procedure DelReadOnlyAttr(sFileName: string);//注册function Reg32(const sFilename: string): Integer;//获得桌面路径function GetDeskTopDir: string;//获得程序文件夹路径function GetProgramFilesDir: string;//获得操作系统版本 [0 windows98] [1 windowsNT] [2 Windows2000]function GetOSVersion: Integer;//创建快捷方式function CreateLink(aPathObj, aPathLink, aDesc: string; iIcon: Integer): Boolean;//文件操作，拷贝，移动，删除procedure FileOperator(Apphandle: HWND; Op: integer; Source, Dest: string);//取动态连接库版本procedure GetFileVersion(FileName: string; var Major1, Major2, Minor1, Minor2: Word);//安装新组件包function NewPack(const PackName, uID, pID: string): Boolean;//删除组件包function RemovePack(const PackName: string): boolean;//注册组件。返回结果 0--成功；1--创建新包出错function Install_Component(const PackName, DllFile, uID, pID: string): integer;//删除指定名字的组件，名字是在组件服务中看到的组件的名字function Remove_Component(const IIobject: string): Boolean;//关闭组件function ShutdownPack(const PackName: string): Boolean;//检测组件是否存在function PackExists(const IIobject: string): Boolean;const  RegpathClient = '\SoftWare\Your Path\Client';  RegpathServer = '\SoftWare\Your Path\Server\';  CntStr: string = 'Provider=SQLOLEDB.1;Password=%s;Persist Security Info=True;User ID=%s;Initial Catalog=%s;Data Source=%s';  CrDBStr: string = 'CREATE DATABASE %s'    + #13 + 'ON'    + #13 + '(NAME = ''%s'','    + #13 + 'FILENAME = ''%s%s.mdf'','    + #13 + 'SIZE = 1,'    + #13 + 'FILEGROWTH = 10%%)'    + #13 + 'LOG ON'    + #13 + '(NAME = ''%s'','    + #13 + 'FILENAME = ''%s%s.ldf'','    + #13 + 'SIZE = 1,'    + #13 + 'FILEGROWTH = 10%%)';  LocalTestSQL: string = 'SELECT * FROM Table';  CWTestSQL: string = 'SELECT * FROM Table';  CXTestSQL: string = 'SELECT * FROM Table';implementationfunction IsNumeric(sDestStr: string): Boolean;begin  Result := True;  try    StrToFloat(sDestStr);  except    Result := False;  end;end;function SimplifyWord(sWord: string; iMaxLen: Integer): string;var iCount: Integer;begin  if Length(sWord) > iMaxLen then  begin    Result := Copy(sWord, 1, iMaxLen - 2) + '..'  end else  begin    for iCount := 1 to (iMaxLen - Length(sWord)) do      sWord := ' ' + sWord;    Result := sWord;  end;end;function ReadRegStr(sDWName, KeyName: string; SvrBZ: TSvrOrClient; DefaultValue: string = ''): string;var sRegPath: string;begin  Result := DefaultValue;  if SvrBZ = scClient then    sRegPath := RegpathClient  else    if SvrBZ = scServer then       sRegPath := RegpathServer + sDWName    else       if SvrBZ = scNone then          sRegPath := sDWName;  with TRegistry.Create do  try    RootKey := HKEY_LOCAL_MACHINE;    OpenKey(sRegpath, False);    try      Result := ReadString(KeyName);    except    end;  finally    Free;  end;end;procedure WriteRegStr(sDWName, KeyName, KeyValue: string; SvrBZ: TSvrOrClient;const isExpand : boolean = false);var sRegPath: string;begin  if SvrBZ = scClient then    sRegPath := RegpathClient  else    if SvrBZ = scServer then       sRegPath := RegpathServer + sDWName    else       if SvrBZ = scNone then          sRegPath := sDWName;  with TRegistry.Create do  try    RootKey := HKEY_LOCAL_MACHINE;    OpenKey(sRegpath, True);    if isExpand then      WriteExpandString(KeyName, KeyValue)    else      WriteString(KeyName, KeyValue);  finally    Free;  end;end;function GetComputerName: string;var  PComputeName: array[0..MAX_COMPUTERNAME_LENGTH] of Char;  Length: DWord;begin  Length := SizeOf(PComputeName);  if Windows.GetComputerName(PComputeName, Length) then    Result := StrPas(PComputeName)  else    Result := '';end;procedure InfMsg(const hHandle: HWND; const sMsg: string);var szMsg, szTitle: array[0..1023] of Char;begin  MessageBox(hHandle, StrPCopy(szMsg, sMsg),    StrPCopy(szTitle, '系统信息'), MB_OK or MB_ICONINFORMATION); //MB_ICONEXCLAMATIONend;procedure ClmMsg(const hHandle: HWND; const sMsg: string);var szMsg, szTitle: array[0..1023] of Char;begin  MessageBox(hHandle, StrPCopy(szMsg, sMsg),    StrPCopy(szTitle, '系统信息'), MB_OK or MB_ICONEXCLAMATION); //MB_ICONEXCLAMATIONend;procedure ErrMsg(const hHandle: HWND; const sMsg: string);var szMsg, szTitle: array[0..1023] of Char;begin  MessageBox(hHandle, StrPCopy(szMsg, sMsg),    StrPCopy(szTitle, '系统信息'), MB_OK or MB_ICONERROR); //MB_ICONEXCLAMATIONend;function ConfirmMsg(const hHandle: HWND; const sMsg: string): Boolean;var szMsg, szTitle: array[0..1023] of Char;begin  StrPCopy(szMsg, sMsg);  StrPCopy(szTitle, '系统信息');  Result := MessageBox(hHandle, szMsg, szTitle, MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = IDYES;end;function CheckCDRom(sPath: string): Boolean;var sTempWord: string;  DriveType: TDriveType;begin  Result := False;  if sPath = '' then Exit;  sTempWord := Copy(sPath, 1, 1);  DriveType := TDriveType(GetDriveType(PChar(sTempWord + ':\')));  if DriveType = dtCDROM then Result := Trueend;function CheckDriver(sPath: string): Boolean;var sTempWord: string;  DriveType: TDriveType;begin  Result := False;  if sPath = '' then Exit;  Result := True;  sTempWord := Copy(sPath, 1, 1);  DriveType := TDriveType(GetDriveType(PChar(sTempWord + ':\')));  if (DriveType = dtUnknown) or (DriveType = dtNoDrive) then Result := False;end;function GetWinTempDir: string;var  Path: array[0..Max_Path] of Char;  ResultLength: Integer;begin  ResultLength := GetTempPath(SizeOf(Path), Path);  if (ResultLength <= Max_Path) and (ResultLength > 0) then    Result := StrPas(Path)  else    Result := 'C:\';end;function GetSystemDir: string;var  Path: array[0..Max_Path] of Char;  ResultLength: Integer;begin  ResultLength := GetSystemDirectory(Path, SizeOf(Path));  if (ResultLength <= Max_Path) and (ResultLength > 0) then    Result := StrPas(Path)  else    Result := 'C:\';end;function WinExecAndWait32(Path: PChar; Visibility: Word;  Timeout: DWORD): integer;var  WaitResult: integer;  StartupInfo: TStartupInfo;  ProcessInfo: TProcessInformation;begin  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);  with StartupInfo do  begin    cb := SizeOf(TStartupInfo);    dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;         { you could pass sw_show or sw_hide as parameter: }    wShowWindow := visibility;  end;  if CreateProcess(nil, path, nil, nil, False,    NORMAL_PRIORITY_CLASS, nil, nil,    StartupInfo, ProcessInfo) then  begin    if TimeOut = 0 then      WaitResult := WaitForSingleObject(ProcessInfo.hProcess, infinite)    else      WaitResult := WaitForSingleObject(ProcessInfo.hProcess, TimeOut);    { timeout is in miliseconds or INFINITE if you want to wait forever }    Result := WaitResult;  end  else  { error occurs during CreateProcess see help for details }    Result := GetLastError;end;function SearchFiles(DirName: string;  Files: TStrings;  FileName: string = '*.*';  Attr: Integer = faAnyFile;  FullFileName: Boolean = True;  IncludeNormalFiles: Boolean = True;  IncludeSubDir: Boolean = True): Boolean;  procedure AddToResult(FileName: TFileName);  begin    if FullFileName then      Files.Add(DirName + FileName)    else      Files.Add(FileName);  end;var  SearchRec: TSearchRec;begin  DirName := IncludeTrailingBackslash(DirName);  Result := FindFirst(DirName + FileName, Attr, SearchRec) = 0;  if Result then    repeat    //去掉 '.' 和 '..'      if (SearchRec.Name = '.') or        (SearchRec.Name = '..') then        Continue;    //如果包括普通文件      if IncludeNormalFiles then      //添加到查找结果中        AddToResult(SearchRec.Name)      else      //检查文件属性与指定属性是否相符        if (SearchRec.Attr and Attr) <> 0 then        //添加到查找结果中          AddToResult(SearchRec.Name);    //如果是子目录，在子目录中查找      if IncludeSubDir then        if (SearchRec.Attr and faDirectory) <> 0 then          SearchFiles(DirName + SearchRec.Name,            Files, FileName, Attr,            FullFileName,            IncludeNormalFiles,            IncludeSubDir);    until FindNext(SearchRec) <> 0;  FindClose(SearchRec);end;//查找所有子目录function SearchDirs(DirName: string;  Dirs: TStrings;  FullFileName: Boolean = True;  IncludeSubDir: Boolean = True): Boolean;begin  Result := SearchFiles(DirName, Dirs, '*.*', faDirectory, FullFileName, False, IncludeSubDir);end;procedure DeleteTree(sDir: string);var  sr: TSearchRec;begin  if sDir = '' then Exit;{$I-}  try    if FindFirst(sDir + '\*.*', faAnyFile, sr) = 0 then    begin      if not ((sr.Name = '.') or (sr.Name = '..')) then      begin        try          DelReadOnlyAttr(sDir + '\' + sr.Name);          DeleteFile(PChar(sDir + '\' + sr.Name));        except        end;      end;      while FindNext(sr) = 0 do      begin        if not ((sr.Name = '.') or (sr.Name = '..') or (sr.Attr = faDirectory)) then        begin          DelReadOnlyAttr(sDir + '\' + sr.Name);          DeleteFile(PChar(sDir + '\' + sr.Name));        end;        if (sr.Attr = faDirectory) and (sr.Name <> '.') and (sr.Name <> '..') then        try          DeleteTree(sDir + '\' + sr.Name);        except        end;      end;      Sysutils.FindClose(sr);      RmDir(sDir);    end;  except  end;end;procedure DelReadOnlyAttr(sFileName: string);var Attrs: Integer;begin  if not FileExists(sFileName) then Exit;  Attrs := FileGetAttr(sFileName);  if Attrs and faReadOnly <> 0 then    FileSetAttr(sFileName, Attrs - faReadOnly);end;function Reg32(const sFilename: string): Integer;var res: integer;  exe_str: string;begin  exe_str := 'regsvr32.exe /s "' + sFilename + '"';  res := WinExec(pchar(exe_str), SW_HIDE);  case res of    0: Result := 1; // out of memory;    ERROR_BAD_FORMAT: Result := 2; //The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).    ERROR_FILE_NOT_FOUND: Result := 3; //The specified file was not found.    ERROR_PATH_NOT_FOUND: Result := 4; //The specified path was not found  else    Result := 0;  end;end;function GetDeskTopDir: string;var PIDL: PItemIDList;  Path: array[0..MAX_PATH] of Char;begin  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);  SHGetPathFromIDList(PIDL, Path);  Result := Path;end;function GetProgramFilesDir: string;var PIDL: PItemIDList;  Path: array[0..MAX_PATH] of Char;begin  SHGetSpecialFolderLocation(0, CSIDL_PROGRAMS, PIDL);  SHGetPathFromIDList(PIDL, Path);  Result := Path;end;function GetOSVersion: Integer;var  OSVer: TOSVERSIONINFO;begin  OSVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);  GetVersionEx(OSVer);  if OSVer.dwPlatformId = 1 then    Result := 0  else if (OSVer.dwPlatformId = 2) and (OSVer.dwMajorVersion = 4) then    Result := 1  else if (OSVer.dwPlatformId = 2) and (OSVer.dwMajorVersion = 5) then    Result := 2  else Result := -1;end;function CreateLink(aPathObj, aPathLink, aDesc: string; iIcon: Integer): Boolean;const  IID_IPersistFile: TGUID = (D1: $0000010B; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));var sLink: IShellLink;  PersFile: IPersistFile;begin  Result := false;  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,    CLSCTX_INPROC_SERVER, IID_IShellLinkA, sLink)) then  begin    sLink.SetPath(PChar(aPathObj));    sLink.SetWorkingDirectory(pChar(ExtractFilePath(aPathObj)));    sLink.SetDescription(PChar(aDesc));    if iIcon >= 0 then sLink.SetIconLocation(PChar(aPathObj), iIcon);    if SUCCEEDED(sLink.QueryInterface(IID_IPersistFile, PersFile)) then    begin      PersFile.Save(StringToOLEStr(aPathLink), TRUE);      Result := true;    end;  end;end;procedure FileOperator(Apphandle: HWND; Op: integer; Source, Dest: string);var  FileOperator: TSHFileOpStruct;  CharSetFrom, CharSetTo: array[0..1023] of char;begin  FileOperator.Wnd := Apphandle;  FileOperator.wFunc := Op;  FileOperator.fFlags := FileOperator.fFlags + FOF_NOCONFIRMATION;  FillChar(CharSetFrom, SizeOf(CharSetFrom), #0);  CopyMemory(@CharSetFrom[0], @Source[1], Length(Source));  FileOperator.pFrom := @CharSetFrom[0];  FillChar(CharSetTo, SizeOf(CharSetTo), #0);  CopyMemory(@CharSetTo[0], @Dest[1], Length(Dest));  FileOperator.pTo := @CharSetTo[0];  SHFileOperation(FileOperator);end;procedure GetFileVersion(FileName: string; var Major1, Major2, Minor1, Minor2: Word);var  Info: Pointer;  InfoSize: DWORD;  FileInfo: PVSFixedFileInfo;  FileInfoSize: DWORD;  Tmp: DWORD;begin  InfoSize := GetFileVersionInfoSize(PChar(FileName), Tmp);  Major1 := 0; Major2 := 0; Minor1 := 0; Minor2 := 0;  if InfoSize = 0 then    //file doesnt have version info/exist  else  begin    GetMem(Info, InfoSize);    try      GetFileVersionInfo(PChar(FileName), 0, InfoSize, Info);      VerQueryValue(Info, '\', Pointer(FileInfo), FileInfoSize);      Major1 := FileInfo.dwFileVersionMS shr 16;      Major2 := FileInfo.dwFileVersionMS and $FFFF;      Minor1 := FileInfo.dwFileVersionLS shr 16;      Minor2 := FileInfo.dwFileVersionLS and $FFFF;    finally      FreeMem(Info, FileInfoSize);    end;  end;end;function PackExists(const IIobject: string): Boolean;var  MTS_catalog: MTSAdmin_TLB.ICatalog;  MTS_catalogpack, MTS_componentsInPack: MTSAdmin_TLB.ICatalogCollection;  MTS_catalogobject, MTS_catalogcomponent: MTSAdmin_TLB.ICatalogObject;  COM_catalog: COMAdmin_TLB.ICOMAdminCatalog;  COM_catalogpack, COM_componentsInPack: COMAdmin_TLB.ICatalogCollection;  COM_catalogobject, COM_catalogcomponent: COMAdmin_TLB.ICatalogObject;  ww, qq: integer;begin  result := false;  try    case GetOSVersion of      1: begin          MTS_catalog := MTSAdmin_TLB.CoCatalog.Create;          MTS_catalogpack := MTS_catalog.GetCollection('Packages') as MTSAdmin_TLB.ICatalogCollection;          MTS_catalogpack.Populate;          for ww := 0 to MTS_catalogpack.Count - 1 do          begin            MTS_catalogobject := MTS_catalogpack.Get_Item(ww) as MTSAdmin_TLB.ICatalogObject;            MTS_componentsInPack := MTS_catalogpack.GetCollection('ComponentsInPackage', MTS_catalogobject.Key) as MTSAdmin_TLB.ICatalogCollection;            try              MTS_componentsInPack.Populate;              for qq := 0 to MTS_componentsInPack.Count - 1 do              begin                MTS_catalogcomponent := (MTS_componentsInPack.item[qq] as MTSAdmin_TLB.ICatalogObject);                if uppercase(MTS_catalogcomponent.name) = uppercase(IIObject) then                begin                  MTS_componentsInPack.Remove(qq);                  MTS_componentsInPack.SaveChanges;                  result := True; break;                end;              end;            except              continue;            end;            if result then break;          end;        end;      2: begin          COM_catalog := COMAdmin_TLB.CoCOMAdminCatalog.Create;          COM_catalogpack := COM_catalog.GetCollection('Applications') as COMAdmin_TLB.ICatalogCollection;          COM_catalogpack.Populate;          for ww := 0 to COM_catalogpack.Count - 1 do          begin            COM_catalogobject := COM_catalogpack.Get_Item(ww) as COMAdmin_TLB.ICatalogObject;            COM_componentsInPack := COM_catalogpack.GetCollection('Components', COM_catalogobject.Key) as COMAdmin_TLB.ICatalogCollection;            try              COM_componentsInPack.Populate;              for qq := 0 to COM_componentsInPack.Count - 1 do              begin                COM_catalogcomponent := (COM_componentsInPack.item[qq] as COMAdmin_TLB.ICatalogObject);                if uppercase(COM_catalogcomponent.name) = uppercase(IIObject) then                begin                  result := True; break;                end;              end;            except              continue;            end;            if result then break;          end;        end;    end;  finally    COM_catalogobject := nil;    COM_catalogpack := nil;    COM_catalog := nil;    MTS_catalogobject := nil;    MTS_catalogpack := nil;    MTS_catalog := nil;  end;end;function NewPack(const PackName, uID, pID: string): Boolean;var  MTS_catalog: MTSAdmin_TLB.ICatalog;  MTS_catalogpack: MTSAdmin_TLB.ICatalogCollection;  MTS_catalogobject: MTSAdmin_TLB.ICatalogObject;  COM_catalog: COMAdmin_TLB.ICOMAdminCatalog;  COM_catalogpack: COMAdmin_TLB.ICatalogCollection;  COM_catalogobject: COMAdmin_TLB.ICatalogObject;  ww: integer;  Pack_Name: string;  Pack_Existed: Boolean;begin  Pack_Existed := False;  Pack_Name := Trim(uppercase(PackName));  try    Result := False;      case GetOSVersion of      1: begin // winnt          MTS_catalog := MTSAdmin_TLB.CoCatalog.Create;          MTS_catalogpack := MTS_catalog.GetCollection('Packages') as MTSAdmin_TLB.ICatalogCollection;          MTS_catalogpack.Populate;          for ww := 0 to MTS_catalogpack.Count - 1 do          begin            MTS_catalogobject := MTS_catalogpack.Get_Item(ww) as MTSAdmin_TLB.ICatalogObject;            if uppercase(MTS_catalogobject.Value['Name']) = Pack_Name then            begin              Pack_Existed := True;              //MTS_catalogobject.Value['Activation'] := 'Local';              MTS_catalogpack.SaveChanges;              //MTS_catalogobject.Value['Identity'] := uID;              //MTS_catalogobject.Value['Password'] := pID;              MTS_catalogpack.SaveChanges;              Break;            end;          end;          if not Pack_Existed then          begin            MTS_catalogobject := MTS_catalogpack.Add as MTSAdmin_TLB.ICatalogObject;            MTS_catalogobject.Value['Name'] := PackName;            //MTS_catalogobject.Value['Identity'] := uID;            //MTS_catalogobject.Value['Password'] := pID;            //MTS_catalogobject.Value['Activation'] := 'Local';            MTS_catalogpack.SaveChanges;          end;        end;      2: begin //win2000          COM_catalog := COMAdmin_TLB.CoCOMAdminCatalog.Create;          COM_catalogpack := COM_catalog.GetCollection('Applications') as COMAdmin_TLB.ICatalogCollection;          COM_catalogpack.Populate;          for ww := 0 to COM_catalogpack.Count - 1 do          begin            COM_catalogobject := COM_catalogpack.Get_Item(ww) as COMAdmin_TLB.ICatalogObject;            if uppercase(COM_catalogobject.Value['Name']) = Pack_Name then            begin              Pack_Existed := True;              //COM_catalogobject.Value['Activation'] := 'Local';              //COM_catalogpack.SaveChanges;              //COM_catalogobject.Value['Identity'] := uID;              //COM_catalogobject.Value['Password'] := pID;              COM_catalogpack.SaveChanges;              Break;            end;          end;          if not Pack_Existed then          begin            COM_catalogobject := COM_catalogpack.Add as COMAdmin_TLB.ICatalogObject;            COM_catalogobject.Value['Name'] := PackName;            //COM_catalogobject.Value['Identity'] := uID;            //COM_catalogobject.Value['Password'] := pID;            //COM_catalogobject.Value['Activation'] := 'Local';            COM_catalogpack.SaveChanges;          end;        end;    end;    Result := True;  finally    COM_catalogobject := nil;    COM_catalogpack := nil;    COM_catalog := nil;    MTS_catalogobject := nil;    MTS_catalogpack := nil;    MTS_catalog := nil;  end;end;function RemovePack(const PackName: string): boolean;var  MTS_catalog: MTSAdmin_TLB.ICatalog;  MTS_catalogpack: MTSAdmin_TLB.ICatalogCollection;  MTS_catalogobject: MTSAdmin_TLB.ICatalogObject;  COM_catalog: COMAdmin_TLB.ICOMAdminCatalog;  COM_catalogpack: COMAdmin_TLB.ICatalogCollection;  COM_catalogobject: COMAdmin_TLB.ICatalogObject;  ww: integer;  Pack_Name: string;begin  Pack_Name := Trim(uppercase(PackName));  try    Result := false;      case GetOSVersion of      1: begin //winnt          MTS_catalog := MTSAdmin_TLB.CoCatalog.Create;          MTS_catalogpack := MTS_catalog.GetCollection('Packages') as MTSAdmin_TLB.ICatalogCollection;          MTS_catalogpack.Populate;          for ww := 0 to MTS_catalogpack.Count - 1 do          begin            MTS_catalogobject := MTS_catalogpack.Get_Item(ww) as MTSAdmin_TLB.ICatalogObject;            if uppercase(MTS_catalogobject.Value['Name']) = Pack_Name then            begin              MTS_catalogpack.Remove(ww);              MTS_catalogpack.SaveChanges;              Break;            end;          end;        end;      2: begin //win2000          COM_catalog := COMAdmin_TLB.CoCOMAdminCatalog.Create;          COM_catalogpack := COM_catalog.GetCollection('Applications') as COMAdmin_TLB.ICatalogCollection;          COM_catalogpack.Populate;          for ww := 0 to COM_catalogpack.Count - 1 do          begin            COM_catalogobject := COM_catalogpack.Get_Item(ww) as COMAdmin_TLB.ICatalogObject;            if uppercase(COM_catalogobject.Value['Name']) = Pack_Name then            begin              COM_catalogpack.Remove(ww);              COM_catalogpack.SaveChanges;              Break;            end;          end;        end;    end;    Result := True;  finally    COM_catalogobject := nil;    COM_catalogpack := nil;    COM_catalog := nil;    MTS_catalogobject := nil;    MTS_catalogpack := nil;    MTS_catalog := nil;  end;end;function Install_Component(const PackName, DllFile, uID, pID: string): integer;var  ww: integer;  keyy: OleVariant;  MTS_catalog: MTSAdmin_TLB.ICatalog;  MTS_catalogpack, MTS_componentsInPack: MTSAdmin_TLB.ICatalogCollection;  MTS_catalogobject: MTSAdmin_TLB.ICatalogObject;  MTS_util: MTSAdmin_TLB.IComponentUtil;  COM_catalog: COMAdmin_TLB.ICOMAdminCatalog;begin  result := 0;  if NewPack(PackName, uID, pID) then  try    case GetOSVersion of      1: begin          MTS_catalog := MTSAdmin_TLB.CoCatalog.Create;          MTS_catalogpack := MTS_catalog.GetCollection('Packages') as MTSAdmin_TLB.ICatalogCollection;          MTS_catalogpack.Populate;          for ww := 0 to MTS_catalogpack.Count - 1 do          begin            MTS_catalogobject := MTS_catalogpack.Get_Item(ww) as MTSAdmin_TLB.ICatalogObject;            if uppercase(MTS_catalogobject.Value['Name']) = uppercase(PackName) then            begin              keyy := MTS_catalogobject.Key;              Break;            end;          end;          MTS_componentsInPack := MTS_catalogpack.GetCollection('ComponentsInPackage', keyy) as MTSAdmin_TLB.ICatalogCollection;          MTS_util := MTS_componentsInPack.GetUtilInterface as MTSAdmin_TLB.IComponentUtil;          try            MTS_util.InstallComponent(DllFile, '', '');          except            Result := 1;          end;        end;      2: begin          COM_catalog := COMAdmin_TLB.CoCOMAdminCatalog.Create;          try            COM_catalog.InstallComponent(PackName, DllFile, '', '');          except            Result := 1;          end;        end;    end;  finally    MTS_catalogobject := nil;    MTS_catalogpack := nil;    MTS_catalog := nil;    MTS_componentsInPack := nil;    MTS_util := nil;    COM_catalog := nil;  end;end;function Remove_Component(const IIobject: string): Boolean;var  MTS_catalog: MTSAdmin_TLB.ICatalog;  MTS_catalogpack, MTS_componentsInPack: MTSAdmin_TLB.ICatalogCollection;  MTS_catalogobject, MTS_catalogcomponent: MTSAdmin_TLB.ICatalogObject;  COM_catalog: COMAdmin_TLB.ICOMAdminCatalog;  COM_catalogpack, COM_componentsInPack: COMAdmin_TLB.ICatalogCollection;  COM_catalogobject, COM_catalogcomponent: COMAdmin_TLB.ICatalogObject;  ww, qq: integer;begin  result := false;  try    case GetOSVersion of      1: begin          MTS_catalog := MTSAdmin_TLB.CoCatalog.Create;          MTS_catalogpack := MTS_catalog.GetCollection('Packages') as MTSAdmin_TLB.ICatalogCollection;          MTS_catalogpack.Populate;          for ww := 0 to MTS_catalogpack.Count - 1 do          begin            MTS_catalogobject := MTS_catalogpack.Get_Item(ww) as MTSAdmin_TLB.ICatalogObject;            MTS_componentsInPack := MTS_catalogpack.GetCollection('ComponentsInPackage', MTS_catalogobject.Key) as MTSAdmin_TLB.ICatalogCollection;            try              MTS_componentsInPack.Populate;              for qq := 0 to MTS_componentsInPack.Count - 1 do              begin                MTS_catalogcomponent := (MTS_componentsInPack.item[qq] as MTSAdmin_TLB.ICatalogObject);                if uppercase(MTS_catalogcomponent.name) = uppercase(IIObject) then                begin                  MTS_componentsInPack.Remove(qq);                  MTS_componentsInPack.SaveChanges;                  result := True;                  break;                end;              end;            except              continue;            end;            if result then break;          end;        end;      2: begin          COM_catalog := COMAdmin_TLB.CoCOMAdminCatalog.Create;          COM_catalogpack := COM_catalog.GetCollection('Applications') as COMAdmin_TLB.ICatalogCollection;          COM_catalogpack.Populate;          for ww := 0 to COM_catalogpack.Count - 1 do          begin            COM_catalogobject := COM_catalogpack.Get_Item(ww) as COMAdmin_TLB.ICatalogObject;            COM_componentsInPack := COM_catalogpack.GetCollection('Components', COM_catalogobject.Key) as COMAdmin_TLB.ICatalogCollection;            try              COM_componentsInPack.Populate;              for qq := 0 to COM_componentsInPack.Count - 1 do              begin                COM_catalogcomponent := (COM_componentsInPack.item[qq] as COMAdmin_TLB.ICatalogObject);                if uppercase(COM_catalogcomponent.name) = uppercase(IIObject) then                begin                  COM_componentsInPack.Remove(qq);                  COM_componentsInPack.SaveChanges;                  result := True;                  break;                end;              end;            except              continue;            end;            if result then break;          end;        end;    end;    Result := True;  finally    COM_catalogobject := nil;    COM_catalogpack := nil;    COM_catalog := nil;    MTS_catalogobject := nil;    MTS_catalogpack := nil;    MTS_catalog := nil;  end;end;function ShutdownPack(const PackName: string): Boolean;var  ww: integer;  MTS_catalog: MTSAdmin_TLB.ICatalog;  MTS_catalogpack: MTSAdmin_TLB.ICatalogCollection;  MTS_catalogobject: MTSAdmin_TLB.ICatalogObject;  MTS_PackageUtil: MTSAdmin_TLB.IPackageUtil;  COM_catalog: COMAdmin_TLB.ICOMAdminCatalog;begin  Result := False;  try    case GetOSVersion of      1: begin          // IPackageUtil.ShutdownPackage 的参数是 ID 不是 NAME ,所以要通过 NAME 找到 ID          MTS_catalog := MTSAdmin_TLB.CoCatalog.Create;          MTS_catalogpack := MTS_catalog.GetCollection('Packages') as MTSAdmin_TLB.ICatalogCollection;          MTS_catalogpack.Populate;          ww := 0;          while ww < MTS_catalogpack.Count do          begin            MTS_catalogobject := MTS_catalogpack.Get_Item(ww) as MTSAdmin_TLB.ICatalogObject;            if uppercase(MTS_catalogobject.Value['Name']) = uppercase(PackName) then break;            inc(ww);          end;          if ww < MTS_catalogpack.Count then          begin            MTS_PackageUtil := MTS_catalogpack.GetUtilInterface as MTSAdmin_TLB.IPackageUtil;            MTS_PackageUtil.ShutdownPackage(MTS_catalogobject.Value['ID']);            sleep(5000);            Result := True;          end;        end;      2: begin          COM_catalog := COMAdmin_TLB.CoCOMAdminCatalog.Create;          try            COM_catalog.ShutdownApplication(PackName);            Result := True;          except            Result := False;          end;        end;    end;  finally    COM_catalog := nil;    MTS_catalog := nil;    MTS_catalogpack := nil;    MTS_PackageUtil := nil;  end;end;