ربط دلفي-بأوراكل (odbc) - نسخة قابلة للطباعة

PHP كود :
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.