首页 > 代码库 > Delphi 常用函数记录

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;  //检查驱动器类型是否是CDROM  function CheckCDRom(sPath: string): Boolean;  //检查驱动器是否存在  function CheckDriver(sPath: string): Boolean;  //获得windows临时目录  function GetWinTempDir: string;  //取系统目录  function GetSystemDir: string;  //等待执行Winexe  function 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‘;    implementation    function 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_ICONEXCLAMATION  end;    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_ICONEXCLAMATION  end;    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_ICONEXCLAMATION  end;    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 := True  end;    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;  

  

Delphi 常用函数记录