CnPack Forum

CnPack Forum » 技术板块灌水区 » 自己修改Zeos DBO使其支持加密的SQLite

 
Printable Version | Email to Friend | Subscription | Favorites
Subject: 自己修改Zeos DBO使其支持加密的SQLite
rarnu (橙子)
灌水部部长
Rank: 8Rank: 8


UID 2689
Digest Posts 11
Credits 648
Posts 209
点点分 648
Reading Access 10
Registered 2006-10-2
Status Offline
#1
Post at 2008-12-17 10:09  Profile | Site | Blog | P.M. 
自己修改Zeos DBO使其支持加密的SQLite

昨天提交了一些相关的代码去Source Forge，得到的结果是，对方毫不理睬，并且已经删除了我提交的代码
我尊重他们的协议，不自行发布修改后的Zeos，因此，只能将修改方法公开，以便各位自行修改。

要改的地方不是太多，大家看着我的改法，自己改一下就好了，不是很麻烦

一、修改ZPlainSqLiteDriver.pas
这个文件位于\src\plain目录下

在接口IZSQLitePlainDriver内，修改Open()方法的定义
原始的定义为：function Open(const filename: PChar; mode: Integer; var errmsg: PChar): Psqlite;
修改为：function Open(const filename: PChar; mode: Integer;password: PChar; var errmsg: PChar): Psqlite;

在类TZSQLite28PlainDriver内，修改Open()方法的定义
修改方法同上，定义是一样的
在类TZSQLite3PlainDriver 内，做同样的修改

继续往下，找到 TZSQLite3PlainDriver.Open()方法，作如下修改：
原始的代码为：

[Copy to clipboard]
CODE:
function TZSQLite3PlainDriver.Open(const filename: PChar; mode: Integer; var errmsg: PChar): Psqlite;

var

  Result0: Psqlite;

  Version: string;

  FileNameString: String;

begin

  Result0:= nil;

  Version := LibVersion;

  FileNameString := filename;

  {$IFNDEF VER130}

  if (Version > '3.2.5') then

    ZPlainSqLite3.sqlite_open(PAnsiChar(AnsiToUTF8(FileNameString)), Result0)

  else

  {$ENDIF}

  ZPlainSqLite3.sqlite_open(filename, Result0);

  Result := Result0;

end;

修改为：

[Copy to clipboard]
CODE:
function TZSQLite3PlainDriver.Open(const filename: PChar; mode: Integer; password: PChar; var errmsg: PChar): Psqlite;

var

  Result0: Psqlite;

  Version: string;

  FileNameString: String;

begin

  Result0:= nil;

  Version := LibVersion;

  FileNameString := filename;

  {$IFNDEF VER130}

  if (Version > '3.2.5') then

    ZPlainSqLite3.sqlite_open(PAnsiChar(AnsiToUTF8(FileNameString)), Result0)

  else

  {$ENDIF}

  ZPlainSqLite3.sqlite_open(filename, Result0);

  Result := Result0;

  if password <> EmptyStr then                                                     <--  此处修改

    ZPlainSqLite3.sqlite_key(Result0, password, Length(password));

end;

二、修改ZDbcSqLite.pas
这个文件位于\src\dbc目录下

找到TZSQLiteConnection.Open()方法，作如下修改：
原始代码为：

[Copy to clipboard]
CODE:
procedure TZSQLiteConnection.Open;

var

  ErrorCode: Integer;

  ErrorMessage: PChar;

  LogMessage: string;

  SQL: string;

begin

  if not Closed then Exit;

  ErrorMessage := '';

  LogMessage := Format('CONNECT TO "%s" AS USER "%s"', [Database, User]);

  FHandle := FPlainDriver.Open(PChar(Database), 0, ErrorMessage);

  if FHandle = nil then

  begin

    CheckSQLiteError(FPlainDriver, SQLITE_ERROR, ErrorMessage,  lcConnect, LogMessage);

  end;

  DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol, LogMessage);

  { Turn on encryption if requested }

  if StrToBoolEx(Info.Values['encrypted']) then

  begin

    ErrorCode := FPlainDriver.Key(FHandle, PChar(Password), StrLen(PChar(Password)));

    CheckSQLiteError(FPlainDriver, ErrorCode, ErrorMessage, lcConnect, 'SQLite.Key');

  end;

  try

    SQL := 'PRAGMA show_datatypes = ON';

    ErrorCode := FPlainDriver.Execute(FHandle, PChar(SQL),  nil, nil, ErrorMessage);

    CheckSQLiteError(FPlainDriver, ErrorCode, ErrorMessage, lcExecute, SQL);

{

         SQL := 'PRAGMA empty_result_callbacks = ON';

         ErrorCode := FPlainDriver.Execute(FHandle, PChar(SQL),

           nil, nil, ErrorMessage);

         CheckSQLiteError(FPlainDriver, ErrorCode, ErrorMessage, lcExecute, SQL);

}

    StartTransactionSupport;

  except

    FPlainDriver.Close(FHandle);

    FHandle := nil;

    raise;

  end;

  inherited Open;

end;

修改为：

[Copy to clipboard]
CODE:
procedure TZSQLiteConnection.Open;

var

  ErrorCode: Integer;

  ErrorMessage: PChar;

  LogMessage: string;

  SQL: string;

begin

  if not Closed then Exit;

  ErrorMessage := '';

  LogMessage := Format('CONNECT TO "%s" AS USER "%s"', [Database, User]);

  FHandle := FPlainDriver.Open(PChar(Database), 0, PChar(Password), ErrorMessage);           <--  此处修改

  if FHandle = nil then

  begin

    CheckSQLiteError(FPlainDriver, SQLITE_ERROR, ErrorMessage,  lcConnect, LogMessage);

  end;

  DriverManager.LogMessage(lcConnect, FPlainDriver.GetProtocol, LogMessage);

  { Turn on encryption if requested }

  if StrToBoolEx(Info.Values['encrypted']) then

  begin

    ErrorCode := FPlainDriver.Key(FHandle, PChar(Password), StrLen(PChar(Password)));

    CheckSQLiteError(FPlainDriver, ErrorCode, ErrorMessage, lcConnect, 'SQLite.Key');

  end;

  try

    SQL := 'PRAGMA show_datatypes = ON';

    ErrorCode := FPlainDriver.Execute(FHandle, PChar(SQL),  nil, nil, ErrorMessage);

    CheckSQLiteError(FPlainDriver, ErrorCode, ErrorMessage, lcExecute, SQL);



{

         SQL := 'PRAGMA empty_result_callbacks = ON';

         ErrorCode := FPlainDriver.Execute(FHandle, PChar(SQL),

           nil, nil, ErrorMessage);

         CheckSQLiteError(FPlainDriver, ErrorCode, ErrorMessage, lcExecute, SQL);

}



    StartTransactionSupport;

  except

    FPlainDriver.Close(FHandle);

    FHandle := nil;

    raise;

  end;

  inherited Open;

end;[/code[]



三、修改ZDbcSqliteUtils.pas

这个文件位于\src\dbc目录下



找到ConvertSQLiteTypeToSQLType()法，作如下修改：

原始代码为：[code]

function ConvertSQLiteTypeToSQLType(TypeName: string; var Precision: Integer;

  var Decimals: Integer): TZSQLType;

var

  P1, P2: Integer;

  Temp: string;

begin

  TypeName := UpperCase(TypeName);

  Result := stString;

  Precision := 0;

  Decimals := 0;



  P1 := Pos('(', TypeName);

  P2 := Pos(')', TypeName);

  if (P1 > 0) and (P2 > 0) then

  begin

    Temp := Copy(TypeName, P1 + 1, P2 - P1 - 1);

    TypeName := Copy(TypeName, 1, P1 - 1);

    P1 := Pos(',', Temp);

    if P1 > 0 then

    begin

      Precision := StrToIntDef(Copy(Temp, 1, P1 - 1), 0);

      Decimals := StrToIntDef(Copy(Temp, P1 + 1, Length(Temp) - P1), 0);

    end else

      Precision := StrToIntDef(Temp, 0);

  end;



  if StartsWith(TypeName, 'BOOL') then

    Result := stBoolean

  else if TypeName = 'TINYINT' then

    Result := stByte

  else if TypeName = 'SMALLINT' then

    Result := stShort

  else if TypeName = 'MEDIUMINT' then

    Result := stInteger

  else if StartsWith(TypeName, 'INT') then

    Result := stInteger

  else if TypeName = 'BIGINT' then

    Result := stLong

  else if StartsWith(TypeName, 'REAL') then

    Result := stDouble

  else if StartsWith(TypeName, 'FLOAT') then

    Result := stDouble

  else if (TypeName = 'NUMERIC') or (TypeName = 'DECIMAL')

    or (TypeName = 'NUMBER') then

  begin

   { if Decimals = 0 then

      Result := stInteger

    else} Result := stDouble;

  end

  else if StartsWith(TypeName, 'DOUB') then

    Result := stDouble

  else if TypeName = 'MONEY' then

    Result := stBigDecimal

  else if StartsWith(TypeName, 'CHAR') then

    Result := stString

  else if TypeName = 'VARCHAR' then

    Result := stString

  else if TypeName = 'VARBINARY' then

    Result := stBytes

  else if TypeName = 'BINARY' then

    Result := stBytes

  else if TypeName = 'DATE' then

    Result := stDate

  else if TypeName = 'TIME' then

    Result := stTime

  else if TypeName = 'TIMESTAMP' then

    Result := stTimestamp

  else if TypeName = 'DATETIME' then

    Result := stTimestamp

  else if Pos('BLOB', TypeName) > 0 then

    Result := stBinaryStream

  else if Pos('CLOB', TypeName) > 0 then

    Result := stAsciiStream

  else if Pos('TEXT', TypeName) > 0 then

    Result := stAsciiStream;



  if (Result = stInteger) and (Precision <> 0) then

  begin

    if Precision <= 2 then

      Result := stByte

    else if Precision <= 4 then

      Result := stShort

    else if Precision <= 9 then

      Result := stInteger

    else Result := stLong;

  end;



  if (Result = stString) and (Precision = 0) then

    Precision := 256;

end;

修改为：

[Copy to clipboard]
CODE:
function ConvertSQLiteTypeToSQLType(TypeName: string; var Precision: Integer;

  var Decimals: Integer): TZSQLType;

var

  P1, P2: Integer;

  Temp: string;

begin

  TypeName := UpperCase(TypeName);

  Result := stString;

  Precision := 0;

  Decimals := 0;



  P1 := Pos('(', TypeName);

  P2 := Pos(')', TypeName);

  if (P1 > 0) and (P2 > 0) then

  begin

    Temp := Copy(TypeName, P1 + 1, P2 - P1 - 1);

    TypeName := Copy(TypeName, 1, P1 - 1);

    P1 := Pos(',', Temp);

    if P1 > 0 then

    begin

      Precision := StrToIntDef(Copy(Temp, 1, P1 - 1), 0);

      Decimals := StrToIntDef(Copy(Temp, P1 + 1, Length(Temp) - P1), 0);

    end else

      Precision := StrToIntDef(Temp, 0);

  end;



  if StartsWith(TypeName, 'BOOL') then

    Result := stBoolean

  else if TypeName = 'TINYINT' then

    Result := stByte

  else if TypeName = 'SMALLINT' then

    Result := stShort

  else if TypeName = 'MEDIUMINT' then

    Result := stInteger

  else if StartsWith(TypeName, 'INT') then

    Result := stInteger

  else if TypeName = 'BIGINT' then

    Result := stLong

  else if StartsWith(TypeName, 'REAL') then

    Result := stDouble

  else if StartsWith(TypeName, 'FLOAT') then

    Result := stDouble

  else if (TypeName = 'NUMERIC') or (TypeName = 'DECIMAL')

    or (TypeName = 'NUMBER') then

  begin

   { if Decimals = 0 then

      Result := stInteger

    else} Result := stDouble;

  end

  else if StartsWith(TypeName, 'DOUB') then

    Result := stDouble

  else if TypeName = 'MONEY' then

    Result := stBigDecimal

  else if StartsWith(TypeName, 'CHAR') then

    Result := stString

  else if TypeName = 'VARCHAR' then

    Result := stString

  else if TypeName = 'VARBINARY' then

    Result := stBytes

  else if TypeName = 'BINARY' then

    Result := stBytes

  else if TypeName = 'DATE' then

    Result := stDate

  else if TypeName = 'TIME' then

    Result := stTime

  else if TypeName = 'TIMESTAMP' then

    Result := stTimestamp

  else if TypeName = 'DATETIME' then

    Result := stTimestamp

  else if Pos('BLOB', TypeName) > 0 then

    Result := stBinaryStream

  else if Pos('CLOB', TypeName) > 0 then

    Result := stAsciiStream

  else if Pos('TEXT', TypeName) > 0 then

    Result := stString;                                                 <--  此处修改



  if (Result = stInteger) and (Precision <> 0) then

  begin

    if Precision <= 2 then

      Result := stByte

    else if Precision <= 4 then

      Result := stShort

    else if Precision <= 9 then

      Result := stInteger

    else Result := stLong;

  end;



  if (Result = stString) and (Precision = 0) then

    Precision := 4096;                                               <--  此处修改

end;

四、保存修改，编译，安装
经过修改的Zeos即可支持加密的SQLite数据库，示例代码如下：

[Copy to clipboard]
CODE:
ZConnection1.Password := 'sa';

ZConnection1.Connect;

ZTable1.TableName := 'Employees';

ZTable1.Open;

[ 本帖最后由 rarnu 于 2008-12-17 10:22 编辑 ]




Rarnu
CnPack Interfacer
rarnu@cnpack.org
Top
lixupeng
普通灌水员
Rank: 2



UID 33687
Digest Posts 0
Credits 66
Posts 31
点点分 66
Reading Access 10
Registered 2007-12-11
Status Offline
#2
Post at 2008-12-17 23:23  Profile | Blog | P.M. 
不懂纯支持下
Top
jAmEs_
灌水部部长
Rank: 8Rank: 8



Medal No.1  
UID 886
Digest Posts 0
Credits 1134
Posts 600
点点分 1134
Reading Access 10
Registered 2005-6-5
Location 广东
Status Offline
#3
Post at 2009-6-2 11:08  Profile | Blog | P.M. 
好像有用~~~不過不是很理解為何SF不接受這個修改：）

[ 本帖最後由 jAmEs_ 於 2009-6-2 12:09 編輯 ]
Top
kendling (小冬)
高级版主
Rank: 8Rank: 8
MyvNet


Medal No.1  
UID 703
Digest Posts 5
Credits 978
Posts 580
点点分 978
Reading Access 101
Registered 2005-2-18
Location 广东
Status Offline
#4
Post at 2009-6-2 14:03  Profile | Site | Blog | P.M.  | QQ | Yahoo!
发布协议的问题吧？




小冬
http://MyvNet.com
Top
jAmEs_
灌水部部长
Rank: 8Rank: 8



Medal No.1  
UID 886
Digest Posts 0
Credits 1134
Posts 600
点点分 1134
Reading Access 10
Registered 2005-6-5
Location 广东
Status Offline
#5
Post at 2009-6-3 09:38  Profile | Blog | P.M. 
什麽概念？
Top
ouyongke (I'm OuKe)
灌水科科长
Rank: 3Rank: 3


UID 12147
Digest Posts 1
Credits 102
Posts 38
点点分 102
Reading Access 10
Registered 2007-4-28
Location 湖南/北京
Status Offline
#6
Post at 2009-8-28 17:47  Profile | Blog | P.M. 

橙子！   橙子大大的贴不顶就太不仗义啦！




城市里，我像一颗尘埃，默默地存在.........
Top
yinque
新警察
Rank: 1



UID 44954
Digest Posts 0
Credits 4
Posts 2
点点分 4
Reading Access 10
Registered 2009-12-14
Status Offline
#7
Post at 2009-12-14 11:14  Profile | Blog | P.M. 
不用这么麻烦
在创建一个TZConnection时， 只要Properties属性置为"encrypted=true"， 那么ZerosDBO会自动按加密方式去访问sqlite
但运行会出错： 'Access violation at address 00000000.read of address 00000000'
只要把  ZDbcSqiliteutils.pas 中的   PlainDriver.FreeMem(ErrorMessage);    注释掉即可
Top
yinque
新警察
Rank: 1



UID 44954
Digest Posts 0
Credits 4
Posts 2
点点分 4
Reading Access 10
Registered 2009-12-14
Status Offline
#8
Post at 2009-12-14 11:20  Profile | Blog | P.M. 
上指 ZeosDBO 6.64
这个版本应该是几年前就有了
不过到现在也没更新的版本
Top
 




All times are GMT++8, the time now is 2024-11-25 16:24

    本论坛支付平台由支付宝提供 携手打造安全诚信的交易社区 Powered by Discuz! 5.0.0  © 2001-2006 Comsenz Inc.
Processed in 0.011485 second(s), 9 queries , Gzip enabled
TOP

Clear Cookies - Contact Us - CnPack Website - Archiver - WAP