hmadn.pas

Delphi三层原代码掩饰及补丁

unit hmADN;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, ADODB, Registry,hmStatusIntf, StdCtrls, HMSqlTools, HMStrTools;

type
  THMConnectString = class(TPersistent)
  private
    FConnectString: string;
    FActive: Boolean;
    FFilePath: string;
    FServerType: integer;
    procedure SetConnectString(const Value: string);
    procedure SetActive(const Value: Boolean);
    procedure SetFilePath(const Value: string);
    procedure SetServerType(const Value: integer);
  protected
    procedure EnumConnect(Sender: TObject; ID: integer; Name: string; Value: string);
  public
    constructor Create;
    procedure Connect;
    property ConnectString: string read FConnectString write SetConnectString;
    property Active: Boolean read FActive write SetActive;
    property FilePath: string read FFilePath write SetFilePath;
    property ServerType: integer read FServerType write SetServerType;
  end;

type
  THMADN = class(TADOConnection)
  private
    FCheckSql: IStatus;
    FDemo: Boolean;
    FOdbcPath: string;
    FServerType: integer;
    procedure SetDemo(const Value: Boolean);
    procedure SetOdbcPath(const Value: string);
    procedure SetServerType(const Value: integer);
    { Private declarations }
  protected
    procedure DoConnect; override;
    procedure DoDisconnect; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure LoadConnectString;
  published
    property CheckSql: IStatus read FCheckSql write FCheckSql;
    property Demo: Boolean read FDemo write SetDemo;
    property OdbcPath: string read FOdbcPath write SetOdbcPath;
    property ServerType: integer read FServerType write SetServerType;
  end;

var
  FHMConnectString: THMConnectString;

function OdbcConnectString: string;
function GetODBCRegistry: string;
function GetODBCType: integer;

implementation

{ THMADN }

constructor THMADN.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ConnectionString := GetODBCRegistry;
  //FOdbcPath := FHMConnectString.FFilePath;
  LoginPrompt := False;
  FServerType := GetODBCType;
end;

procedure THMADN.DoConnect;
begin
  ConnectionString := GetODBCRegistry;
  FServerType := GetODBCType;
  if Assigned(CheckSql) and (FCheckSql <> nil) then
    begin
      CheckSql.AddScriptMsg(Name, ConnectionString);
      CheckSql.AddScriptMsg(Name, 'Odbc.ini Path:' + FOdbcPath);
    end;
  if ConnectionString <> '' then
    inherited DoConnect
  else
    ShowMessage('ConnectStrig is Empty');
end;

procedure THMADN.DoDisconnect;
begin
  inherited DoDisconnect;
end;

procedure THMADN.LoadConnectString;
begin
  if Connected then Close;
  ConnectionString := GetODBCRegistry;
  FServerType := GetODBCType;
end;

procedure THMADN.SetDemo(const Value: Boolean);
begin
  FDemo := Value;
  FServerType := 1;
  if csDesigning in ComponentState then
    begin
      if Value then
        begin
          if ConnectionString = '' then
            ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=True;Data Source=SERVER;User ID=sa;Password=;'
        end
      else
        ConnectionString := '';
    end;
end;

{ HMConnectString }

constructor THMConnectString.Create;
begin
  inherited Create;
  FConnectString := '';
  FActive := False;
end;

procedure THMConnectString.Connect;
{var
  Ini: THMIniFile;
  Filename: string;
  buf: pchar;}
begin
{  Filename := 'Odbc.ini';
  FFilePath := '';
  try
    GetMem(Buf, 1024);
    if GetSystemDirectory(Buf, 1024) > 0 then
      begin
        FileName := Strpas(Buf);
        if SubStr(FileName, Length(FileName), 1) <> '\' then
          FileName := FileName + '\';
        FileName := FileName + 'Odbc.ini';
      end;
    FreeMem(Buf);
  except
    on E: Exception do
      ShowMessage('Get file Odbc.ini error!');
  end;
  if FileExists(FileName) then
    begin
      try
        FConnectString := 'Provider=SQLOLEDB.1;Persist Security Info=True;';
        Ini := THMIniFile.Create;
        Ini.LoadFromFile(FileName);
        Ini.EnumItems('Connect', EnumConnect);
        Ini.Free;
        FActive := True;
        FFilePath := FileName;
      except
        on E: Exception do
          ShowMessage('EnumConnect[Odbc.ini] Error!');
      end;
    end
  else
    raise Exception.Create('Can not Find File:[Odbc.ini]');}
end;

procedure THMConnectString.EnumConnect(Sender: TObject; ID: integer; Name,
  Value: string);
begin
  if UpperCase(Name) = 'DATASOURCE' then
    FConnectString := FConnectString + 'Data Source=' + Value + ';';
  if UpperCase(Name) = 'USERID' then
    FConnectString := FConnectString + 'User ID=' + Value + ';';
  if UpperCase(Name) = 'PASSWORD' then
    FConnectString := FConnectString + 'Password=' + Value + ';';
end;

procedure THMConnectString.SetActive(const Value: Boolean);
begin
  FActive := Value;
  if Value and (FConnectString = '') then Connect;
  if not Value then FConnectString := '';
end;

procedure THMConnectString.SetConnectString(const Value: string);
begin
  //FConnectString := Value;
end;

procedure THMConnectString.SetFilePath(const Value: string);
begin
  //FFilePath := Value;
end;

{ Public }

function OdbcConnectString: string;
begin
  if FHMConnectString = nil then
    FHMConnectString := THMConnectString.Create;
  if not FHMConnectString.FActive then
    FHMConnectString.Connect;
  Result := FHMConnectString.ConnectString;
end;

procedure THMADN.SetOdbcPath(const Value: string);
begin
  //FOdbcPath := Value;
end;

function GetODBCRegistry: string;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\Software\HunMing\ODBC', False);
  if Reg.ValueExists('ConnectionString') then
    Result := Reg.ReadString('ConnectionString')
  else
    Exception.Create('Registry [ConnectionString] is not Find');
  Reg.CloseKey;
  Reg.Free;
end;

function GetODBCType: integer;
var
  Reg: TRegistry;
begin
  Result := 0;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\Software\HunMing\ODBC', False);
  if Reg.ValueExists('Type') then
    Result := Reg.ReadInteger('Type')
  else
    Exception.Create('Registry [Type] is not Find');
  Reg.CloseKey;
  Reg.Free;
end;

procedure THMConnectString.SetServerType(const Value: integer);
begin
  FServerType := Value;
end;

procedure THMADN.SetServerType(const Value: integer);
begin
  FServerType := Value;
end;

initialization

finalization
  if FHMConnectString <> nil then
    FHMConnectString.Free;
end.