udbm.pas

数据库通用工具

unit Udbm;

interface

uses
  Windows, SysUtils, Classes, DB, ADODB, Forms, DBTables, IniFiles, Registry,
  ShellAPI, Math;

type
  TDatabaseParam = Record
    ServerIP,
    ServerName,
    ODBCName,
    sPort,
    DatabaseName,
    UserName,
    Password : String;
  end;

  PassType = record
    PassCode: string;
    FileType: string;
    FileTime: TDateTime;
  end;
  
  Tdbm = class(TDataModule)
    adocLink: TADOConnection;
    dbODBCMySQL: TDatabase;
    qryPubMySQL: TQuery;
    dbDB2: TDatabase;
    qryPubDB2: TQuery;
    dbSQLServer: TDatabase;
    qryPubSQL: TQuery;
    adoQPub: TADOQuery;
    ADOTable1: TADOTable;
    Table1: TTable;
    Table2: TTable;
    Table3: TTable;
    procedure DataModuleCreate(Sender: TObject);
    function linkMySQL( sODBC,sDBName,sUser,sPass : string ):boolean;
    function connectMySQLDB():boolean;
    function testDBMySQLLink( bShowSet: Boolean = True ):Boolean;
    procedure listODBCs( sl : TStrings );
    function linkADOAccess( sPathName: string; mdbPass : string; mdbUser : string='admin' ) : boolean;
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function getFieldTypeSQL( sDPName : string ) : string;
  function getFieldTypeMySQL( sDPName : string ) : string;
  function getFieldTypeAccess( sDPName : string ) : string;
  function getFieldTypeDB2( sDPName : string ) : string;
  function saveDatabaseParam( vDatabaseParam:TDatabaseParam; sKey : string ):Boolean;
  function getDatabaseParam( sKey : string ) : TDatabaseParam;
  function CreateOdbcMySQL(DateSourceName,Server,sPORT,sUser,sPWD,DataBase:String) : Integer;
  function ShowMSG( Text: string; Caption: string='提示'; Flags: Longint=MB_OK): Integer;
  procedure URLink(URL:string);
  function ExecAccessFile(FName: string): PassType;
  function FullString(Const Source,Seep:String; Const Number:Integer; Const bLeftAdd:Boolean=True ): String;
  
var
  dbm: Tdbm;
  appPath : string;
  sys32Path : string;
  databaseParam : TDatabaseParam;
  aPassWord : PassType;
  //----------------------------------------------------------------------------
  //用于Access数据库解密
  InCode97: array[0..19] of byte =
  ($86, $FB, $EC, $37, $5D, $44, $9C, $FA, $C6, $5E,
    $28, $E6, $13, $00, $00, $00, $00, $00, $00, $00);

//  用户密码区域 }
//  UserCode8: array[0..9] of Word = //89年9月17日前
//  ($8B86, $345D, $2EC6, $C613, $E454, $02F5, $8477, $DFCF, $1134, $C592);
  UserCode: array[0..9] of Word = //89年9月17日后
  ($7B86, $C45D, $DEC6, $3613, $1454, $F2F5, $7477, $2FCF, $E134, $3592);
  
//2079-06-05前  [EC37  9CFA  28E6  8A60  7B36  DFB1  1343  B133  795B  7C2A ]
//2079-06-05后  [ED37  9DFA  29E6  8B60  7A36  DEB1  1243  B033  785B  7D2A ]
{ 固定密码区域 }
  InhereCode: array[0..9] of Word =
  ($37EC, $FA9C, $E628, $608A, $367B, $B1DF, $4313, $33B1, $5B79, $2A7C);
  InhereCode2: array[0..9] of Word =
  ($37ED, $FA9D, $E629, $608B, $367A, $B1DE, $4312, $33B0, $5B78, $2A7D);

  arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
  arXlsEnd: array[0..1] of Word = ($0A, 00);
  arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
  arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
  //----------------------------------------------------------------------------
  
implementation

uses UrmCfgDBMySQL;

{$R *.dfm}

function ExecAccessFile(FName: string): PassType;
  function CovTime(FD: _FileTime): TDateTime;
  var
    TCT: _SystemTime;
    Tmp: _FileTime;
  begin
    FileTimeToLocalFileTime(FD, Tmp);
    FileTimeToSystemTime(Tmp, TCT);
    Result := SystemTimeToDateTime(TCT);
  end;

var
  BaseDate: DWord;
  PassCode: string;
  InhereArray: array[0..19] of Word;
  ReaderArray: array[0..19] of Word;
  Stream: TFileStream;
  i, n: integer;
  TP: TSearchRec;
  FT: TDateTime;
  WTime: TDateTime;
  WSec: DWord;
  M, S: string;
  Buf: array[0..200] of byte;
  Date0: TDateTime;
  Date1: TDateTime;
  Date2: TDateTime;
const
  XorStr = $823E6C94;
begin
  //use SysUtils
  if FindFirst(FName, faAnyFile, TP) = 0 then
    FindClose(TP);

  // awen add （保证释放FindFile句柄和资源)
  FT := CovTime(TP.FindData.ftCreationTime);

  Stream := TFileStream.Create(FName, fmOpenRead or fmShareDenyNone);
  // awen modify (让程序能在任何情况下——即使文件正在被使用——都能打开它
  // 不过如果数据库是以独占方式被Access打开了的话，本程序就无法打开了。)
  
  try // awen add (如果不加入try块的话，对97版解密后不会执行Stream.free语句)
  Stream.Seek($00, 00); Stream.Read(Buf[0], 200);
  if Buf[$14] = 0 then
  begin
    PassCode := '';
    Stream.Seek($42, 00); Stream.Read(Buf[0], 20);
    for i := 0 to 19 do
      PassCode := PassCode + chr(Buf[i] xor InCode97[i]);
    Result.PassCode := PassCode;
    Result.FileType := 'ACCESS-97';
    Result.FileTime := FT;
    Exit; // 按Access97版本处理
  end;

  Date0 := EncodeDate(1978, 7, 01);
  Date1 := EncodeDate(1989, 9, 17);
  Date2 := EncodeDate(2079, 6, 05);

  Stream.Seek($42, 00); Stream.Read(ReaderArray[0], 40);
  Stream.Seek($75, 00); Stream.Read(BaseDate, 4);
  finally // awen add
  Stream.Free;
  end; // awen add

  S := format('文件：%s，[', [FName]);
  for i := $42 to $42 + 55 do
  begin
    if i = $72 then
      M := '-'
    else
      M := '';
    S := S + #32 + M + IntToHex(Buf[i], 2);
  end;
  S := '';
  if (BaseDate >= $90000000) and (BaseDate < $B0000000) then
  begin
    WSec := BaseDate xor $903E6C94;
    WTime := Date2 + WSec / 8192 * 2;
  end
  else
  begin
    WSec := BaseDate xor $803E6C94;
    WTime := Date1 + WSec / 8192;
    if WSec and $30000000 <> 0 then
    begin
      WSec := $40000000 - WSec;
      WTime := Date1 - WSec / 8192 / 2;
    end;
  end;
  if WTime < Date1 then
  begin //89年9月17日前
//    if FName = 'db96.mdb' then Showmessage(inttostr(BaseDate));
    S := '917前';
    for i := 0 to 9 do
    begin
      InhereArray[i * 2] := (Trunc(WTime) - Trunc(Date0)) xor UserCode[i] xor $F000;
      InhereArray[i * 2 + 1] := InhereCode[i];
    end;
  end
  else
  begin //89年9月17日后
    S := '917后';
    if WTime >= Date2 then
    begin //2076.6.5之后
      for i := 0 to 9 do
      begin
        InhereArray[i * 2] := (Trunc(WTime) - Trunc(Date1)) xor UserCode[i];
        InhereArray[i * 2 + 1] := InhereCode2[i];
      end;
    end
    else
    begin //2076.6.5之前
      for i := 0 to 9 do
      begin
        InhereArray[i * 2] := (Trunc(WTime) - Trunc(Date1)) xor UserCode[i];
        InhereArray[i * 2 + 1] := InhereCode[i];
      end;
    end;
  end;
  PassCode := '';
  for i := 0 to 19 do
  begin
    N := InhereArray[i] xor ReaderArray[i];
    if N <> 0 then PassCode := PassCode + Chr(N);
  end;
  Result.FileType := 'ACCESS-2000/XP';  // awen modify (我发现此程序可以解密OfficeXP版的数据库)
  Result.FileTime := WTime;
  Result.PassCode := PassCode;
end;

procedure URLink(URL:string);
begin
  //uses ShellAPI;
  try
    //WinExec('D:\Program Files\EditPlus 2\editplus.exe f:\asd.xml',SW_NORMAL);
    //ShellExecute(application.Handle ,'open',pchar(filepaths),nil,nil,SW_ShowNormal);
    ShellExecute(0, nil, PChar(URL), nil, nil, SW_NORMAL);  //SW_MAXIMIZE,SW_NORMAL
  except
  end;
  //}
  {
  ShellExecute(0, nil, 'F:', nil, nil, SW_NORMAL);
  ShellExecute(0, nil, 'F:\temp.txt', nil, nil, SW_NORMAL);
  ShellExecute(handle, 'open', 'C:\ mydocument\abc.exe','','',SW_SHOWNORMAL); 
  //}
end;

function ShowMSG( Text: string; Caption: string='提示'; Flags: Longint=MB_OK): Integer;
begin

  Result := Application.MessageBox( PChar(Text), PChar(Caption), Flags);

end;

function saveDatabaseParam( vDatabaseParam:TDatabaseParam; sKey : string ):Boolean;
var
  vIniFile : TIniFile;
begin
  result := false;
  try
    vIniFile := TIniFile.Create(appPath+'\dbConnect.ini');
  except
    //('数据库连接文件不存在，将采用默认连接');
    exit;
  end;

  if Trim(sKey)='' then sKey := 'DBConfig';
  {
  ServerIP,
  ServerName,
  ODBCName,
  sPort,
  DatabaseName,
  UserName,
  Password : String;
  }
  with  vDatabaseParam, vIniFile do
  begin
    WriteString( sKey,'ServerIP',ServerIP);
    WriteString( sKey,'ServerName',ServerName);
    WriteString( sKey,'ODBCName',ODBCName);
    WriteString( sKey,'sPort',sPort);
    WriteString( sKey,'DatabaseName',DatabaseName);
    WriteString( sKey,'UserName',UserName);
    WriteString( sKey,'Password',Password);
  end;
  
  vIniFile.Free;
  result := true;

end;

function getDatabaseParam( sKey : string ) : TDatabaseParam;
var
  vIniFile : TIniFile;
begin
//  with result do
//  begin
//    ServerName := 'mySQLodbc';
//    DatabaseName := 'cygl';
//    UserName := 'root';
//    Password := 'sa';
//  end;

  try
    vIniFile := TIniFile.Create(appPath+'\dbConnect.ini');
  except
    //('数据库连接文件不存在，将采用默认连接');
    exit;
  end;
  {
  ServerIP,
  ServerName,
  ODBCName,
  sPort,
  DatabaseName,
  UserName,
  Password : String;
  }
  with  result, vIniFile do
  begin
    ServerIP    := ReadString(sKey,'ServerIP','127.0.0.1');//
    ServerName  := ReadString(sKey,'ServerName','');//mySQLodbc,cyglODBC
    ODBCName    := ReadString(sKey,'ODBCName','');//
    sPort       := ReadString(sKey,'sPort','');//
    DatabaseName:= ReadString(sKey,'DatabaseName','');//cygl
    UserName    := ReadString(sKey,'UserName','' );
    Password    := ReadString(sKey,'Password','' );
    vIniFile.Free;
  end;
  
end;

function Tdbm.linkMySQL( sODBC,sDBName,sUser,sPass : string ):boolean;
begin
  //
  Result := False;
  with dbODBCMySQL do
  begin
    if Connected then  Connected := false;

    Params.Values['ODBC DSN']   :=  sODBC;
    Params.Values['DATABASE NAME'] :=  sDBName;
    Params.Values['USER NAME']  :=  sUser;
    Params.Values['PASSWORD']   :=  sPass;

    try
      Connected := true;
    except
      Exit;
    end;

  end;
  Result := dbODBCMySQL.Connected;

end;  

function Tdbm.connectMySQLDB():boolean;
begin
  try
//    databaseParam := getDatabaseParam('DBMySQL');
    with databaseParam do
    begin
      if (trim(ODBCName)='') or (trim(DatabaseName)='') then
      begin
        result := false;
        exit;
      end;

      result := linkMySQL(ODBCName,DatabaseName,UserName,Password);
      
    end;
//    saveDatabaseParam(databaseParam,'DBMySQL');
  except
    result := false;
  end;
  
end;

function CreateOdbcMySQL(DateSourceName,Server,sPORT,sUser,sPWD,DataBase:String) : Integer;
var
  TheReg:TRegistry;
  KeyName,Driver, ss:string;
begin
  {在用delphi自动配置odbc数据源时如果是Sql server数据库如何配置
   在注册表中可以写入用户名、数据库、驱动程序文件、数据源名称、服务器名称，
   但是SQl 服务器的密码怎么办呀
  }
  Result := 0;
  //Driver:='C:\WINDOWS\SYSTEM\SQLSRV32.DLL';
//  Driver := 'C:\WINNT\system32\myodbc3.dll';
  Driver := sys32Path+'\myodbc3.dll';

  try
    TheReg:=TRegistry.Create;
    TheReg.RootKey:=HKEY_LOCAL_MACHINE;
    //-------------------------------------------------
    //test odbc Driver
    KeyName:='\software\odbc\ODBCINST.INI\MySQL ODBC 3.51 Driver';
    if not TheReg.KeyExists(KeyName) then
    begin
      ShowMSG('MySQL ODBC 驱动不存在，创建失败!');
      Result := -1;//odbc Driver not Exists
      exit;
    end;

    if TheReg.OpenKey(KeyName,false) then
    begin
      ss := TheReg.ReadString('Driver');
      if not SameText(ss,Driver) then
      begin
        Driver := ss;
      end;

    end;
    //-------------------------------------------------
    KeyName:='\software\odbc\odbc.ini\'+DateSourceName;
    //1011 add 删除此处，改为存在就覆盖现有设置
    if TheReg.KeyExists(KeyName) then
    begin
      if ShowMsg( '数据源 [ '+DateSourceName+' ] 已存在，要覆盖吗？','提示', mb_okcancel+mb_defbutton2+mb_iconquestion) <> id_ok then
      begin
        //TheReg.ReadString('');        
        Result := -2;//odbc Exists
        exit;
      end;
    end;
    //}
    
    if TheReg.OpenKey(KeyName,true) then
    begin
      TheReg.WriteString('DATABASE',DataBase);//cygl
      TheReg.WriteString('Driver',Driver);//C:\WINNT\system32\myodbc3.dll
      TheReg.WriteString('PORT',sPORT);//3307
      TheReg.WriteString('PWD',sPWD);//sa
      TheReg.WriteString('SERVER',Server);//127.0.0.1
      TheReg.WriteString('UID',sUser);//root
      TheReg.CloseKey;
    end;

    KeyName:='\software\odbc\odbc.ini\ODBC Data Sources';

    if TheReg.OpenKey(KeyName,false) then
    begin
      TheReg.WriteString(DateSourceName,'MySQL ODBC 3.51 Driver'); 
      TheReg.CloseKey;
    end;
  finally
    TheReg.Free;
  end;
  Result := 1;//

end;

function Tdbm.testDBMySQLLink( bShowSet: Boolean = True ) : Boolean;
var
  ss : string;
begin
  //测试数据库连接，自动配置
  Result := False;
  if dbODBCMySQL.Connected then
  begin
    Result := True;
    Exit;
  end
  else//not link
  begin

    if not bShowSet then
    begin
      Result := False;
      Exit;
    end; 

    databaseParam := getDatabaseParam('DBMySQL');
    if not connectMySQLDB() then
    begin
      Application.CreateForm(TfrmCfgDBMySQL, frmCfgDBMySQL);
      if frmCfgDBMySQL.ShowModal = 1 then
      begin
        frmCfgDBMySQL.free;
        connectMySQLDB;
      end
      else
      begin
        frmCfgDBMySQL.free;
        exit;
      end;
    end;
    //----------------------------------------
    Result := dbODBCMySQL.Connected;

  end;

end;

function GetSysPath():   string;
var
  vBuffer:   array[0..MAX_PATH]   of   Char;
begin
  //C:\WINNT\system32
  GetSystemDirectory(vBuffer,   MAX_PATH);
  Result   :=   vBuffer;   
end;

function Tdbm.linkADOAccess( sPathName: string; mdbPass : string; mdbUser : string='admin' ) : boolean;
var
  ss : String;
//  slt:TStringList;
  i:integer;
begin
  Result := False;                   
//  vDir := ExtractFilePath(application.ExeName);
  if not FileExists( sPathName ) then Exit;

  if adocLink.Connected then
    adocLink.Connected := false;
  {
  Provider=MSDASQL.1;
  Password=why;
  Persist Security Info=True;
  User ID=admin;
  Extended Properties="DBQ=E:\card\cardBase.mdb;
  DefaultDir=E:\delphi\card;Driver={Microsoft Access Driver (*.mdb)};       //}

  {