Subject: 自己修改Zeos DBO使其支持加密的SQLite [Print This Page]
Author:
rarnu Time: 2008-12-17 10:09 Subject: 自己修改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()方法，作如下修改：
原始的代码为：
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;
修改为：
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()方法，作如下修改：
原始代码为：
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;
修改为：
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;
修改为：
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数据库，示例代码如下：
ZConnection1.Password := 'sa';
ZConnection1.Connect;
ZTable1.TableName := 'Employees';
ZTable1.Open;
[ 本帖最后由 rarnu 于 2008-12-17 10:22 编辑 ]
Author:
lixupeng Time: 2008-12-17 23:23
不懂纯支持下
Author:
jAmEs_ Time: 2009-6-2 11:08
好像有用~~~不過不是很理解為何SF不接受這個修改：）
[ 本帖最後由 jAmEs_ 於 2009-6-2 12:09 編輯 ]
Author:
kendling Time: 2009-6-2 14:03
发布协议的问题吧？
Author:
jAmEs_ Time: 2009-6-3 09:38
什麽概念？
Author:
ouyongke Time: 2009-8-28 17:47
橙子！ 橙子大大的贴不顶就太不仗义啦！
Author:
yinque Time: 2009-12-14 11:14
不用这么麻烦
在创建一个TZConnection时， 只要Properties属性置为"encrypted=true"， 那么ZerosDBO会自动按加密方式去访问sqlite
但运行会出错： 'Access violation at address 00000000.read of address 00000000'
只要把 ZDbcSqiliteutils.pas 中的 PlainDriver.FreeMem(ErrorMessage); 注释掉即可
Author:
yinque Time: 2009-12-14 11:20
上指 ZeosDBO 6.64
这个版本应该是几年前就有了
不过到现在也没更新的版本
| Welcome to CnPack Forum (http://bbs.cnpack.org/) |
Powered by Discuz! 5.0.0 |