www.pudn.com > transfox.rar > ODBC.pas

unit odbc; 
 
interface 
uses registry,windows,Classes,SysUtils,Dialogs; 
type 
  Todbc = class(TComponent) 
private 
  function Sysinfo: boolean; 
public 
  procedure CreateOdbc(dbtype:smallint;DsnName,DbDir:string); 
  procedure DeleteOdbc(DsnName:string); 
end; 
 
const Fox=100; 
      DBase=200; 
      Accessdb=300; 
 
implementation 
 
{ Todbc } 
 
procedure Todbc.CreateOdbc(Dbtype:smallint;DsnName,DbDir:string); 
var 
  registerTemp : tregistry; 
  bdata : array[ 0..0 ] of byte; 
  Dbtypestr:string; 
begin 
 
  if (trim(DsnName)='') or  (trim(DbDir)='') then exit; 
 
  case Dbtype of 
  Fox:Dbtypestr:='Microsoft Visual FoxPro driver'; 
  DBase:Dbtypestr:='Microsoft DBase Driver (*.dbf)'; 
  Accessdb:Dbtypestr:='Driver do Microsoft Access (*.mdb)'; 
  end; 
  RegisterTemp := tregistry.create; //建立一个registry实例 
  with RegisterTemp do 
  begin 
     rootkey:=hkey_local_machine;                                    //设置根键值为hkey_local_machine 
     //找到software\odbc\odbc.ini\odbc data sources 
    if openkey('software\odbc\odbc.ini\odbc data sources',true) then 
    writestring(DsnName, dbtypestr)                                //注册一个dsn名称 
    else 
    begin 
      showmessage('创建失败'); 
      exit; 
    end; 
 
    closekey; 
 
    case Dbtype of 
    FOX:begin 
          if openkey('software\odbc\odbc.ini\'+DsnName,true) then 
          begin 
            writestring('BackgroundFetch','YES'); 
            writestring('Collate','Machine'); 
            writestring('Deleted','YES'); 
            writestring('Description',''); 
             //判断操作系统 
            if Sysinfo then 
              writestring('driver', 'C:\windows\System32\vfpodbc.dll' ) 
            else  writestring('driver', 'C:\WINNT\System32\vfpodbc.dll' );//驱动程序dll文件 
            writestring('exclusive','NO');                           //非独占方式 
            writestring('Null','YES'); 
            writestring('SetNoCountOn','NO'); 
            writestring('SourceDB',DbDir);                           //数据库目录 
            writestring('SourceType','DBF'); 
         end else 
         begin 
           showmessage('创建失败'); 
           exit; 
         end; 
         closekey; 
        end; 
  DBase:begin 
          if openkey('software\odbc\odbc.ini\'+DsnName,true) then 
          begin 
            writestring('DefaultDir',DbDir); 
            if Sysinfo then 
              writestring('driver', 'c:\Windows\system32\odbcjt32.dll' ) 
            else  writestring('driver', 'c:\winnt\system32\odbcjt32.dll' );//驱动程序dll文件 
            writeinteger('driverid', 21); 
            writestring('FIL','dBase III;'); 
            writeinteger('safetransaction', 0 ); 
            writestring('uid','');                                //用户名称 
          end  else 
          begin 
            showmessage('创建失败'); 
            exit; 
          end; 
          closekey; 
          if openkey('software\odbc\odbc.ini\'+DsnName+'\engines\Xbase',true) then 
          begin 
            writestring('CollatingSequence','ASCII'); 
            bdata[0]:=0; 
            writebinarydata('Deleted',bdata,1); 
            writestring('ImplicitCommitSync',''); 
            writeinteger('PageTimeout',5); 
            writebinarydata('Statistics',bdata,1); 
            writeinteger('Threads',3); 
            writestring('UserCommitSync','Yes'); 
          end  else 
          begin 
            showmessage('创建失败'); 
            exit; 
          end; 
          closekey; 
        end; 
 Accessdb:begin 
          if openkey('software\odbc\odbc.ini\'+DsnName,true) then 
          begin 
            writestring('DBQ',DbDir);                   //数据库目录 
            writestring('description', '我的新数据源' );//数据源描述 
            if Sysinfo then 
            writestring('driver', 'c:\Windows\system32\odbcjt32.dll' ) 
            else  writestring('driver', 'c:\winnt\system32\odbcjt32.dll' );//驱动程序dll文件 
            writestring('FIL','MS Access;' );          //filter依据 
            (*WriteString( 'PWK', 'fd' );*)//密码 
            writeinteger('SafeTransactions', 0 );      //支持的事务操作数目 
            writestring('UID', '' );//用户名称 
            bdata[0] := 0; 
            writebinarydata('Exclusive', bdata, 1 ); //非独占方式 
            writebinarydata('ReadOnly', bdata, 1 ); //非只读方式 
          end  else 
          begin 
            showmessage('创建失败'); 
            exit; 
          end; 
          closekey; 
          if openkey('software\odbc\odbc.ini\'+DsnName+'\Engines\jet',true) then 
          begin 
            writestring('ImplicitCommitSync', 'yes' ); 
            writeinteger('MaxBufferSize',512);       //缓冲区大小 
            writeinteger('PageTimeout',5);         //页超时 
            writeinteger('Threads',3);              //支持的线程数目 
            writestring('UserCommitSync','yes'); 
          end else 
          begin 
            showmessage('创建失败'); 
            exit; 
          end; 
          closekey; 
        end; 
    end; 
    free; 
    showmessage('创建成功'); 
  end; 
end; 
 
 
 
procedure Todbc.DeleteOdbc(DsnName:string); 
var registerTemp : tregistry; 
begin 
  registerTemp:=tregistry.Create; 
  with registerTemp do 
  begin 
    rootkey:=hkey_local_machine; 
    if DeleteKey('SOFTWARE\ODBC\ODBC.INI\'+DsnName) then 
      showmessage('删除成功!') 
    else 
    begin 
      showmessage('删除失败!'); 
      exit; 
    end; 
    closekey; 
    free; 
  end; 
end; 
 
function Todbc.Sysinfo: boolean; 
var 
  OSVI:OSVERSIONINFO; 
begin 
  OSVI.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO); 
  GetVersionEx(OSVI); 
  if OSVI.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS then //WIN95/98 
  result:=true else result:=false; 
end; 
 
end.