genaccessfunc.pas

通用Access操作

    TableList.Free;
  end;
end;

function AccessTableExists(AccessCon: TADOConnection; //Access连接
  ATable: string //表名
  ): Boolean;
var
  TableList: TStringList;
//  AccessCont: TADOConnection;
  i: Integer;
begin
  Result := False;
  TableList := TStringList.Create;
  try
    AccessCon.GetTableNames(TableList);
    //Result := TableList.IndexOfName(ATable) <> -1;
    for i := 0 to TableList.Count - 1 do
    begin
      if UpperCase(TableList[i]) = UpperCase(ATable) then
      begin
        Result := True;
        Break;
      end;
    end;
  finally
    TableList.Free;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////

function AccessColumnExists(AccessCon: TADOConnection; //Access连接
  ATable: string; //表名
  AColumn: string //列名
  ): Boolean;
var
  QueTemp: TADOQuery;
  sSQL: string;
  i: Integer;
begin
  Result := False;
  QueTemp := TADOQuery.Create(nil);
  QueTemp.Connection := AccessCon;
  sSQL := 'select top 1 * from ' + ATable;
  if SetAdoQue(QueTemp, sSQL) then
  begin
    for i := 0 to QueTemp.FieldCount - 1 do
    begin
      if UpperCase(QueTemp.Fields[i].FieldName) = UpperCase(AColumn) then
      begin
        Result := True;
        Break;
      end;
    end;
  end;
  QueTemp.Free;
end;
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////

procedure SQLServer2Access(AccessFullName: string; //Access数据库完整文件名
  ASQLServer: string; //SQL Server服务器名
  AUserID: string; //SQL Server用户名
  APassword: string; //SQL Server用户口令
  ADBName: string; //SQL Server数据库名
  ATable: string; //SQL Server表名
  PassWord: string = '');
var
  AccessCont: TADOConnection;
  sqltmp: string;
begin
  AccessCont := TADOConnection.Create(nil);
  try
    AccessCont.CommandTimeout := 0;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + PassWord + ';'
      + 'Persist Security Info=True;Data Source=' + AccessFullName;
    //目的表存在则删除
    if AccessTableExists(AccessFullName, ATable) then DropAccessTable(AccessFullName, ATable);
    sqltmp := 'SELECT * INTO [' + ATable + '] FROM [' + ATable + '] IN [ODBC] [ODBC;Driver=SQL Server;'
      + 'UID=' + AUserID + ';PWD=' + APassword + ';Server=' + ASQLServer
      + ';DataBase=' + ADBName + ';]';
    AccessCont.Open;
    AccessCont.Execute(sqltmp);
  finally
    AccessCont.Free;
  end;
end;

procedure SQLServer2Access(ASQLConn, AAccessCon: TADOConnection; //Access连接
  ATable: string //SQL Server表名
  );
var
  iCount: Integer;
  sSQL: string;
  i: Integer;
  QueS, QueD: TADOQuery;
begin
  if not AccessTableExists(AAccessCon, ATable) then
  begin
    ShowMessage('找不到相同的表[' + ATable + ']');
    Exit;
  end;
  try
    sSQL := 'delete from ' + ATable;
    AAccessCon.Execute(sSQL);
    QueS := TADOQuery.Create(nil);
    QueD := TADOQuery.Create(nil);
    QueS.Connection := ASQLConn;
    QueD.Connection := AAccessCon;
    sSQL := 'select * from ' + ATable;
    QueS.SQL.Clear;
    QueS.SQL.Add(sSQL);
    QueS.Open;
    QueD.SQL.Clear;
    QueD.SQL.Add(sSQL);
    QueD.Open;
    if QueS.RecordCount > 0 then
    begin
      QueS.First;
      iCount := QueS.FieldCount;
      while not QueS.Eof do
      begin
        QueD.Append;
        for i := 0 to iCount - 1 do
        begin
          if QueS.Fields[i].DataType = ftAutoInc then
          begin
            Continue;
          end;
          QueD.FieldByName(QueS.Fields[i].FieldName).AsVariant := QueS.FieldByName(QueS.Fields[i].FieldName).AsVariant;

        end;
        QueD.Post;
        QueS.Next;
      end;
    end;
    QueS.Free;
    QueD.Free;
    //ShowMessage('成功');
  except
    ShowMessage('Error');
  end;
end;
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////

procedure CreateAccessIndex(AccessFullName: string; //Access数据库完整文件名
  ATable: string; //表名
  AIndex: string; //索引名
  AFields: string; //字段描述
  IsUnique: Boolean; //是否无重复索引
  IsPrimary: Boolean; //是否主键
  PassWord: string = '');
var
  sqltmp: string;
  AccessCont: TADOConnection;
begin
  AccessCont := TADOConnection.Create(nil);
  try
    AccessCont.CommandTimeout := 0;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + PassWord + ';'
      + 'Persist Security Info=True;Data Source=' + AccessFullName;
    if IsUnique then sqltmp := 'CREATE UNIQUE INDEX '
    else sqltmp := 'CREATE INDEX ';
    sqltmp := sqltmp + AIndex + ' ON [' + ATable + '](' + AFields + ')';
    if IsPrimary then sqltmp := sqltmp + ' WITH PRIMARY';
    AccessCont.Open;
    AccessCont.Execute(sqltmp);
  finally
    AccessCont.Free;
  end;
end;
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
//删除Access数据库表

procedure DropAccessTable(AccessFullName: string; //Access数据库完整文件名
  ATable: string; //表名
  PassWord: string = '');
var
  sqltmp: string;
  AccessCont: TADOConnection;
begin
  AccessCont := TADOConnection.Create(nil);
  try
    AccessCont.CommandTimeout := 0;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + PassWord + ';'
      + 'Persist Security Info=True;Data Source=' + AccessFullName;
    sqltmp := 'DROP TABLE [' + ATable + ']';
    AccessCont.Open;
    AccessCont.Execute(sqltmp);
  finally
    AccessCont.Free;
  end;
end;

procedure DropAccessTable(AccessCon: TADOConnection; //Access连接
  ATable: string //表名
  );
var
  sSQL: string;
begin
  sSQL := 'DROP TABLE [' + ATable + ']';
  AccessCon.Execute(sSQL);
end;
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////

function CompactDatabase(AccessFullName: string; PassWord: string = ''): Boolean;
//压缩与修复数据库,覆盖源文件

var
  STempFileName, SConnectionString: string;
  vJE: OleVariant;
begin
  STempFileName := GetTempPathFileName;
  SConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + PassWord + ';Data Source=%s';
  try
    vJE := CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(Format(SConnectionString, [AccessFullName]),
      Format(SConnectionString, [STempFileName]));
    Result := CopyFile(PChar(STempFileName), PChar(AccessFullName), False);
    DeleteFile(STempFileName);
  except
    Result := False;
  end;
end;
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
//从Access导出表至Access数据库

procedure Access2Access(AccessFromName: string; //源Access数据库完整文件名
  AccessToName: string; //目的Access数据库完整文件名
  ATable: string; //Access表名
  sPassWord: string = ''; //Access密码
  dPassWord: string = '');
var
  AccessTo: TADOConnection;
  sqltmp: string;
begin
  AccessTo := TADOConnection.Create(nil);
  try
    AccessTo.CommandTimeout := 0;
    AccessTo.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessTo.LoginPrompt := False;
    AccessTo.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + dPassWord + ';'
      + 'Persist Security Info=True;Data Source=' + AccessToName;
    //目的表存在则删除
    if AccessTableExists(AccessToName, ATable) then DropAccessTable(AccessToName, ATable);
    sqltmp := 'SELECT * INTO [' + ATable + '] FROM [' + ATable + '] IN ' + QuotedStr(AccessFromName);
    AccessTo.Open;
    AccessTo.Execute(sqltmp);
  finally
    AccessTo.Free;
  end;
end;
/////////////////////////////////////////////////////////////////////////////////
end.