adodb.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

function GetFilterStr(Field: TField; Value: Variant; Partial: Boolean = False): string;
var
  Operator,
  FieldName,
  QuoteCh: string;
begin
  QuoteCh := '';
  Operator := '=';
  FieldName := Field.FieldName;
  if Pos(' ', FieldName) > 0 then
    FieldName := Format('[%s]', [FieldName]);
  if VarIsNull(Value) or VarIsClear(Value) then
    Value := 'Null'
  else
    case Field.DataType of
      ftDate, ftTime, ftDateTime:
        QuoteCh := '#';
      ftString, ftFixedChar, ftWideString:
        begin
          if Partial and (Value <> '') then
          begin
            Value := Value + '*';
            Operator := ' like ';     { Do not localize }
          end;
          if Pos('''', Value) > 0 then
            QuoteCh := '#' else
            QuoteCh := '''';
        end;
    end;
  Result := Format('(%s%s%s%s%2:s)', [FieldName, Operator, QuoteCh, VarToStr(Value)]);
end;

function PropertyExists(const PropList: ADOInt.Properties; const PropName: WideString): Boolean;
var
  I: Integer;
begin
  for I := PropList.Count - 1  downto 0 do
    if PropList[I].Name = PropName then
    begin
      Result := True;
      Exit;
    end;
  Result := False;
end;

function FieldListCheckSum(DataSet: TDataset): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to DataSet.Fields.Count - 1 do
    Result := Result + (Integer(Dataset.Fields[I]) shr (I mod 16));
end;

{ Public Global Functions }

procedure CreateUDLFile(const FileName, ProviderName, DataSourceName: WideString);
const
  ConnStrTemplate = 'Provider=%s;Data Source=%s'; { Do not localize }
var
  ConnStr: WideString;
  DataInit: IDataInitialize;
begin
  DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize;
  ConnStr := Format(ConnStrTemplate, [ProviderName, DataSourceName]);
  OleCheck(DataInit.WriteStringToStorage(PWideChar(FileName),
              PWideChar(ConnStr), CREATE_NEW));
end;

procedure GetProviderNames(Names: TStrings);
var
  RSCon: ADORecordsetConstruction;
  Rowset: IRowset;
  SourcesRowset: ISourcesRowset;
  SourcesRecordset: _Recordset;
  SourcesName, SourcesType: TField;
begin
  SourcesRecordset := CreateADOObject(CLASS_Recordset) as _Recordset;
  RSCon := SourcesRecordset as ADORecordsetConstruction;
  SourcesRowset := CreateComObject(CLSID_OLEDB_ENUMERATOR) as ISourcesRowset;
  OleCheck(SourcesRowset.GetSourcesRowset(nil, IRowset, 0, nil, IUnknown(Rowset)));
  RSCon.Rowset := RowSet;
  with TADODataSet.Create(nil) do
  try
    Recordset := SourcesRecordset;
    First;
    SourcesName := FieldByName('SOURCES_NAME'); { do not localize }
    SourcesType := FieldByName('SOURCES_TYPE'); { do not localize }
    Names.BeginUpdate;
    try
      while not EOF do
      begin
        if SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE then
          Names.Add(SourcesName.AsString);
        Next;
      end;
    finally
      Names.EndUpdate;
    end;
  finally
    Free;
  end;
end;

function PromptDataSource(ParentHandle: THandle; InitialString: WideString): WideString;
var
  DataInit: IDataInitialize;
  DBPrompt: IDBPromptInitialize;
  DataSource: IUnknown;
  InitStr: PWideChar;
begin
  Result := InitialString;
  DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize;
  if InitialString <> '' then
    DataInit.GetDataSource(nil, CLSCTX_INPROC_SERVER,
      PWideChar(InitialString), IUnknown, DataSource);
  DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize;
  if Succeeded(DBPrompt.PromptDataSource(nil, ParentHandle,
    DBPROMPTOPTIONS_PROPERTYSHEET, 0, nil, nil, IUnknown, DataSource)) then
  begin
    InitStr := nil;
    DataInit.GetInitializationString(DataSource, True, InitStr);
    Result := InitStr;
  end;
end;

function PromptDataLinkFile(ParentHandle: THandle; InitialFile: WideString): WideString;
var
  SelectedFile: PWideChar;
  InitialDir: WideString;
  DBPrompt: IDBPromptInitialize;
begin
  Result := InitialFile;
  DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize;
  if InitialFile <> '' then
    InitialDir := ExtractFilePath(InitialFile);
    InitialFile := '*.udl';
  if Succeeded(DBPrompt.PromptFileName(ParentHandle, 0, Pointer(InitialDir),
     Pointer(InitialFile), SelectedFile)) then
    Result := SelectedFile;
end;

function DataLinkDir: string;
const
  CVMASKKEY  = 'SOFTWARE\Microsoft\Windows\CurrentVersion';
  COMMONFILESDIR = 'CommonFilesDir';
  DLDRELATIVE = '\System\OLE DB\Data Links';
var
  Buffer: array[0..MAX_PATH] of Char;
  phkResult: HKEY;
  DataSize: Longint;
begin
  Result := '';
  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, CVMASKKEY, 0, KEY_QUERY_VALUE, phkResult) = 0 then
  try
    DataSize := Sizeof(Buffer);
    if RegQueryValueEx(phkResult, COMMONFILESDIR, nil,  nil, @Buffer, @DataSize) = ERROR_SUCCESS then
      Result := string(Buffer) + DLDRELATIVE;
  finally
    RegCloseKey(phkResult);
  end;
end;

function GetDataLinkFiles(FileNames: TStrings; Directory: string = ''): Integer;
const
  FileMask = '\*.udl';
var
  Status: Integer;
  SearchRec: TSearchRec;
begin
  with FileNames do
  begin
    BeginUpdate;
    try
      Clear;
      if Directory = '' then Directory := DataLinkDir;
      Status := FindFirst(Directory+FileMask, faAnyFile, SearchRec);
      while Status = 0 do
      begin
        if (SearchRec.Attr and faDirectory) = 0 then
          Add(SearchRec.Name);
        Status := FindNext(SearchRec);
      end;
      FindClose(SearchRec);
    finally
      EndUpdate;
    end;
  end;
  Result := FileNames.Count;
end;

procedure ApplicationHandleException(Sender: TObject);
begin
  if Assigned(Classes.ApplicationHandleException) then
    Classes.ApplicationHandleException(Sender);
end;

{ TADOConnection }

constructor TADOConnection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConnectionObject := CreateADOObject(CLASS_Connection) as _Connection;
  OleCheck(ConnectionPoint.Advise(Self as IUnknown, FConnEventsID));
  FCommands := TList.Create;
  LoginPrompt := True;
  FIsolationLevel := ilCursorStability;
  CursorLocation := clUseClient;
  FKeepConnection := True;
end;

destructor TADOConnection.Destroy;
begin
  Destroying;
  Close;
  ClearRefs;
  FreeAndNil(FCommands);
  if FConnEventsID > 0 then
    OleCheck(ConnectionPoint.UnAdvise(FConnEventsID));
  FConnEventsID := 0;
  FConnectionObject := nil;
  inherited Destroy;
end;

procedure TADOConnection.Loaded;
begin
  try
    inherited Loaded;
  except
    { Need to trap any exceptions opening while we are loading here }
    ApplicationHandleException(Self);
  end;
end;

procedure TADOConnection.CheckActive;
begin
  if Connected then Exit;
  Open;
  WaitForConnectComplete;
end;

procedure TADOConnection.CheckInactive;
begin
  { At design time, force connection to be closed as needed }
  if Connected and (csDesigning in ComponentState) then
    Close;
end;

procedure TADOConnection.ClearRefs;
begin
  if Assigned(FCommands) then
    while FCommands.Count > 0 do
      TADOCommand(FCommands[0]).Connection := nil;
  while DataSetCount > 0 do
    DataSets[0].Connection := nil;
end;

function TADOConnection.BeginTrans: Integer;
begin
  Result := ConnectionObject.BeginTrans;
  FTransactionLevel := Result;
end;

procedure TADOConnection.CommitTrans;
begin
  ConnectionObject.CommitTrans;
  if FTransactionLevel > 0 then Dec(FTransactionLevel);
  CheckDisconnect;
end;

procedure TADOConnection.RollbackTrans;
begin
  ConnectionObject.RollbackTrans;
  if FTransactionLevel > 0 then Dec(FTransactionLevel);
  CheckDisconnect;
end;

procedure TADOConnection.Cancel;
begin
  ConnectionObject.Cancel;
end;

procedure TADOConnection.WaitForConnectComplete;
begin
  if Assigned(ConnectionObject) then
    while (ConnectionObject.State = adStateConnecting) do
      DBApplication.ProcessMessages;
end;

procedure TADOConnection.DoConnect;
begin
  ConnectionObject.Open(ConnectionObject.ConnectionString, FUserID, FPassword,
    ConnectOptionValues[FConnectOptions]);
  if FDefaultDatabase <> '' then
    ConnectionObject.DefaultDatabase := FDefaultDatabase;
end;

procedure TADOConnection.DoDisconnect;
begin
  if Assigned(ConnectionObject) then
  begin
    while InTransaction do RollbackTrans;
    ConnectionObject.Close;
  end;
end;

procedure TADOConnection.CheckDisconnect;
var
  I: Integer;
begin
  if Connected and not (KeepConnection or InTransaction or (csLoading in ComponentState)) then
  begin
    for I := 0 to DataSetCount - 1 do
      if (DataSets[I].State <> dsInActive) then Exit;
    Close;