unit FiagOracle;
interface
uses Classes;
function QrySQL(AConnStr, AQrySQL: string): TStrings;
function GetOracleInstallPath: string;
function GetTnsNames: TStrings;
function GetPackageNames(AConnStr, AOwner: string): TStrings;
function GetProcNamesOracle(AConnStr, AOwner, APkgName: string):
TStrings;
function GetPackageSrc(AConnStr, AOwner, APkgName: string): TStrings;
implementation
uses FiagSystem, SysUtils, Registry, StrUtils, Variants, Windows, ADODB;
{ Function: Get Oracle Path }
function GetOracleInstallPath: string;
const
RootKey = HKEY_LOCAL_MACHINE;
RegPath = '\SOFTWARE\ORACLE\ALL_HOMES\ID0';
KeyName = 'PATH';
begin
Result := GetRegistryString(RootKey, RegPath, KeyName);
end;
{ Function: Get Oracle TNS Names }
function GetTnsNames: TStrings;
const
TnsNamesORA = '\network\ADMIN\TNSNAMES.ORA';
var
FileContent: TStringList;
ALine, ATmp: string;
AChar: Char;
I, J, iCount, ALen, AStack: Integer;
begin
Result := TStringList.Create;
FileContent := TStringList.Create;
try
FileContent.LoadFromFile(GetOracleInstallPath + TnsNamesORA);
except
on E: Exception do
begin
Exit;
end;
end;
AStack := 0;
ATmp := '';
iCount := FileContent.Count - 1;
for I := 0 to iCount do
begin
ALine := Trim(FileContent[I]);
ALen := Length(ALine);
if (ALen > 0) and ('#' <> ALine[1]) then
begin
for J := 1 to ALen do
begin
AChar := ALine[J];
if AChar = '(' then
Inc(AStack)
else if AChar = ')' then
Dec(AStack)
else
begin
if (AStack = 0) {and (AChar<>' ')} then
ATmp := ATmp + AChar;
end;
end;
end;
end;
FileContent.Free;
ALen := Length(ATmp);
if ATmp[ALen] = '=' then
SetLength(ATmp, ALen - 1);
with (Result as TStringList) do
begin
Delimiter := '=';
DelimitedText := ATmp;
Sort;
end;
end;
function QrySQL(AConnStr, AQrySQL: string): TStrings;
begin
Result := nil;
with TADOQuery.Create(nil) do
begin
ConnectionString := AConnStr;
SQL.Add(AQrySQL);
try
Open;
Result := TStringList.Create;
First;
while not Eof do
begin
Result.Add(Fields[0].AsString);
Next;
end;
except
on E: Exception do
begin
// MessageDlg(SMsgSQLQueryError+E.Message,mtError,[mbOK],0);
end;
end;
Free;
end;
end;
function GetPackageNames(AConnStr, AOwner: string): TStrings;
const
SQryPkgNames = 'SELECT OBJECT_NAME FROM ALL_OBJECTS WHERE OWNER=''%s''' +
' AND OBJECT_TYPE=''PACKAGE'' ORDER BY OBJECT_NAME';
begin
Result := QrySQL(AConnStr, Format(SQryPkgNames, [UpperCase(AOwner)]));
end;
function GetProcNamesOracle(AConnStr, AOwner, APkgName:
string): TStrings;
const
SQryProcNames = 'SELECT PROCEDURE_NAME FROM ALL_PROCEDURES WHERE OWNER=''%s'''
+
'AND OBJECT_NAME=''%s'' ORDER BY PROCEDURE_NAME';
begin
Result := QrySQL(AConnStr,
Format(SQryProcNames, [UpperCase(AOwner), UpperCase(APkgName)]));
end;
function GetPackageSrc(AConnStr, AOwner, APkgName: string):
TStrings;
const
SQryPkgSrc = 'SELECT TRIM(TEXT) FROM ALL_SOURCE WHERE TYPE=''PACKAGE''' +
' AND OWNER=''%s'' AND NAME=''%s'' ORDER BY LINE';
begin
Result := QrySQL(AConnStr,
Format(SQryPkgSrc, [UpperCase(AOwner), UpperCase(APkgName)]));
end;
end.
ربط دلفي-بأوراكل (odbc)
ort