mdb Utils (Access)[4]

[入库:2005年8月18日] [更新:2007年3月24日]

本文简介:选择自 luckyjan 的 blog

   fi               : file of byte;
   by               : byte;
   access97         : boolean;
   fileerror        : boolean;
   count            : integer;
begin
  result := '';
  // init
  fileerror := false;
  access97 := true;
  // open *.mbd file
  assignfile(fi,filename);
  reset(fi);
  // read file
  i := 0;
  repeat
    if not eof(fi) then
    begin
      read(fi,by);
      inc(i);
      if i=$15 then
        access97 := by<>1;
    end;
  until (i = $42) or eof(fi);
  if eof(fi) then
    raise exception.create('无效的数据库文件');
  // read password string
  s1 := '';
  if access97 then count := 12
  else count := 28;
  for i := 0 to count do
  if not eof(fi) then
  begin
    read(fi,by);
    s1 := s1 + chr(by);
  end;
  if eof(fi) then
    raise exception.create('无效的数据库文件');
  //close file
  closefile(fi);
  // decode string
  for i := 0 to count do
     if access97 then
     s1[i + 1] := chr(ord(s1[i + 1]) xor xorarr97[i])
     else
     s1[i + 1] := chr(ord(s1[i + 1]) xor xorarr2000[i]);
  if access97 then
     result := s1
  else
  begin
    result := '';
    for i:=0 to length(s1) div 2 do
    begin
      result := result +widechar(ord(s1[i*2+1])+ord(s1[i*2+2])shl 8);
    end;
  end;
end;

//note: srcdbname and dstdbname cann't be the same
procedure compactmdbdatabase(srcdbname,dstdbname,oldpwd,newpwd:string;baccess97:boolean=true);
var idbengine:_dbengine;
begin
  if oldpwd <>'' then oldpwd := ';pwd='+oldpwd;
  if newpwd <>'' then newpwd := ';pwd='+newpwd;

  if baccess97 then
  begin
    idbengine := createcomobject(dao97.class_dbengine) as _dbengine;
    idbengine.compactdatabase(srcdbname,dstdbname,newpwd,dbversion30,oldpwd);
  end else
  begin
    idbengine := createcomobject(dao2000.class_dbengine) as _dbengine;
    idbengine.compactdatabase(srcdbname,dstdbname,newpwd,dbversion40,oldpwd);
  end;
end;

function getwintempfile:string;
var fn,pn:array[0..max_path-1]of char;
begin
  gettemppath(max_path,pn);
  gettempfilename(pn,'temp',999,fn);
  result := fn;
end;
//note try to clear access2000 database's pwd may raise an error
procedure changemdbpwd(dbname,oldpwd,newpwd:string;baccess97:boolean=true);
var db:database;
    dbengine:_dbengine;
    tempname:string;
begin
  if baccess97 then
  begin
    dbengine := createcomobject(dao97.class_dbengine) as _dbengine;
    db := dbengine.opendatabase(dbname,dbdrivernoprompt,false,';pwd='+oldpwd);
    db.newpassword(oldpwd,widestring(newpwd));
    db.close;
  end else
  begin
    if (newpwd<>'') and (oldpwd <>'')then
    begin
      dbengine := createcomobject(dao2000.class_dbengine) as _dbengine;
      if oldpwd <>'' then
        db := dbengine.opendatabase(dbname,dbdrivernoprompt,false,';pwd='+oldpwd)
      else
        db := dbengine.opendatabase(dbname,dbdrivernoprompt,false,'');
      db.newpassword(oldpwd,widestring(newpwd));
      db.close;
    end else
    begin
      tempname := changefileext(getwintempfile,'.mdb');
      compactmdbdatabase(dbname,tempname,oldpwd,newpwd,false);
      copyfile(pchar(tempname),pchar(dbname),false);
      deletefile(tempname);
    end;

本文关键:mdb Utils (Access)
  相关方案
Google
 

本站最佳浏览方式为 分辨率 1024x768 IE 6.0(或更高版本的 IE浏览器)

go top