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;
이 내용에 흥미가 있습니까?
현재 기사가 여러분의 문제를 해결하지 못하는 경우 AI 엔진은 머신러닝 분석(스마트 모델이 방금 만들어져 부정확한 경우가 있을 수 있음)을 통해 가장 유사한 기사를 추천합니다:
Access Request, Session and Application in Struts2If we want to use request, Session and application in JSP, what should we do? We can obtain Map type objects such as Req...
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
CC BY-SA 2.5, CC BY-SA 3.0 및 CC BY-SA 4.0에 따라 라이센스가 부여됩니다.
좋은 웹페이지 즐겨찾기
