`
happmaoo
  • 浏览: 4543929 次
  • 性别: Icon_minigender_1
  • 来自: 杭州
社区版块
存档分类
最新评论

转贴一篇 自定义数据库 希望对你有帮助

Windows 
阅读更多

//---------------------------------------------------------------------------
//(R)CopyRight KivenSoft International ,inc 1999
//单元名称：数据库单元
//程序名称：电子书库
//作 者：李会文
//开始时间：1998.07.28
//最后修改：1999.07.22
//备注：此单元定义了SRM文件的读写接口
//---------------------------------------------------------------------------
unit SrmUnit;

interface

uses
Windows,SysUtils,Classes, SrmConst;


type
PCharArray=^TCharArray;
TCharArray=array[0..0] of char;
PDwordArray=^TDwordArray;
TDwordArray=array[0..0] of DWORD;
PIntArray=^TIntArray;
TIntArray=array[0..0] of integer;

PTreeData=^TTreeData;
TTreeData=record //索引信息
Pos: longint;
DataType: longint;
end;
PTdArray=^TTdArray;
TTdArray=array[0..0] of TTreeData;

PFileHead=^TFileHead;
TFileHead=record
OpenFlag :Longint; //数据库打开标志
LastViewPos :longint; //关闭时的位置
IndexPos :longint; //索引位置
EditDate :TDateTime; //最后修改日期
Key :DWORD; //密钥
Password :array[0..11] of char; //口令
Author :array[0..15] of char; //作者
BuildDate :TDateTime; //建库日期
DataType :longint; //数据库格式
DataFlag :array[0..7] of char; //数据库标志
Version :longint; //数据库版本
BookMerg :array[0..9] of longint; //10个书签
Keep :longint; //保留字段
end;

//DataType 0:Index 1:Normal Dir 2:Notmal TXT 3:Normal HTML
PIndexHead=^TIndexHead;
TIndexHead=record
DataType :longint; //段类型
Key :DWORD; //密钥
Count :longint; //标题数量
Size :longint; //标题长度
Keep :longint; //保留字段
end;

PDataHead=^TDataHead;
TDataHead=record
DataType :longint; //段类型
Author :array[0..15] of char; //作者
PubDate :TDateTime; //收录日期
Key :DWORD; //密钥
Num :longint; //附件数量
SearchKey :array[0..51] of char; //关键词
Password :array[0..11] of char; //口令
Keep :longint; //保留字段
end;

//------------------------------------------------------------------------
TSrmObject=class
private
FChangeFlag :boolean; //在文件后有增加新信息的变量
FDbChanged :boolean; //数据库属性有变动
FIndexChanged :boolean; //索引有变动
FItemHeadChanged :boolean; //标题头有变动
FItemDataChanged :boolean; //标题内容有变动
FFileHead :TFileHead;
FIndexHead :TIndexHead;
FDataHead :TDataHead;
FFileHandle :integer; //文件句柄
FFileName :string;
FActivePos :longint; //当前读出内容的位置

procedure Encypher(Cypher:DWORD;var Buf;Count:integer);
procedure Decypher(Cypher:DWORD;var Buf;Count:integer);
procedure CreateSrmFile; //建立一个空数据库
procedure SetDbChanged(Value:boolean);
procedure SetIndexChanged(Value:boolean);
procedure SetItemHeadChanged(Value:boolean);
procedure SetItemDataChanged(Value:boolean);
public
property FileName:string read FFileName;
property FileHead:TFileHead read FFileHead write FFileHead;
property IndexHead:TIndexHead read FIndexHead write FIndexHead;
property DataHead:TDataHead read FDataHead write FDataHead;
property ActivePos:longint read FActivePos write FActivePos;
property DbChanged:boolean read FDbChanged write SetDbChanged;
property IndexChanged:boolean read FIndexChanged write SetIndexChanged;
property ItemHeadChanged:boolean read FItemHeadChanged write SetItemHeadChanged;
property ItemDataChanged:boolean read FItemDataChanged write SetItemDataChanged;

constructor Create(Fn:string;Mode:Word);
destructor Destroy;override;
procedure Free;
procedure SaveSrmFile; //不关闭文件情况下保存文件
procedure LoadIndex(Msh,Msd:TMemoryStream); //读索引
procedure SaveIndex(Msh,Msd:TMemoryStream);//写索引
class function IsSrmFile(var Fn:string):boolean;//判断是否是SRM格式数据库文件
procedure ReadItemHead(Ps:longint); //读数据段头
procedure ReadItemData(DataStream:TMemoryStream); //读数据段内容
procedure EditItemHead(Ps:longint); //修改数据头
function AddItemHead:longint; //写数据段头
procedure AddItemData(DataStream:TMemoryStream); //写数据段内容
function GetItemPassword(Ps:longint):string; //得某标题口令
end;
//------------------------------------------------------------------------


implementation

//------------------------------------------------------------------------
procedure TSrmObject.Encypher(Cypher:DWORD;var Buf;Count:integer);
var
i:integer;
begin
Cypher:=not Cypher;
Dec(Count);
for i:=0 to Count do
TDwordArray(Buf)[i]:=TDwordArray(Buf)[i] xor Cypher;
end;

procedure TSrmObject.Decypher(Cypher:DWORD;var Buf;Count:integer);
var
i:integer;
begin
Cypher:=not Cypher;
Dec(Count);
for i:=0 to Count do
TDwordArray(Buf)[i]:=TDwordArray(Buf)[i] xor Cypher;
end;
//------------------------------------------------------------------------

procedure TSrmObject.CreateSrmFile; //建立一个空数据库
var
i:integer;
begin
FFileHandle:=FileCreate(FFileName);
if FFileHandle=-1 then raise Exception.Create(csCanNotCreate);
//添充缺省信息头
with FFileHead do
begin
OpenFlag:=0;
LastViewPos:=0;
IndexPos:=sizeof(TFileHead);
EditDate:=Now;
Key:=GetTickCount;
Password[0]:=#0;
Author[0]:=#0;
BuildDate:=EditDate;
DataType:=0;
Version:=3;
Keep:=0;
DataFlag[0]:='K';
DataFlag[1]:='i';
DataFlag[2]:='v';
DataFlag[3]:='e';
DataFlag[4]:='n';
for i:=0 to 9 do BookMerg[i]:=-1;
end;
//添充缺省索引
with FIndexHead do
begin
DataType:=0;
Key:=GetTickCount;
Count:=0;
Size:=0;
Keep:=0;
end;
//加密写入文件后解密
with FFileHead do
begin
Encypher(Key,Author,4);
Encypher(Key,Password,3);
FileWrite(FFileHandle,FFileHead,sizeof(TFileHead));
FileWrite(FFileHandle,FIndexHead,sizeof(TIndexHead));
Decypher(Key,Author,4);
Decypher(Key,Password,3);
end;
end;

constructor TSrmObject.Create(Fn:string;Mode:Word);
begin
FFileName:=Fn;
FChangeFlag:=false;
FDbChanged:=false;
FIndexChanged:=false;
FItemHeadChanged:=false;
FItemDataChanged:=false;
FDataHead.Keep:=0;
//打开文件时读文件头，否则建新文件
if Mode=fmOpenReadWrite then
begin
FFileHandle:=FileOpen(FFileName,fmOpenReadWrite);
FileRead(FFileHandle,FFileHead,sizeof(TFileHead));
with FFileHead do
begin
Decypher(Key,Password,3);
Decypher(Key,Author,4);
end;
end
else if Mode=fmCreate then
begin
CreateSrmFile;
end;
end;

destructor TSrmObject.Destroy;
begin
if FFileHandle<>-1 then
begin
FileClose(FFileHandle); //关闭文件
FFileHandle:=-1;
end;
inherited;
end;

procedure TSrmObject.Free;
begin
if Assigned(self) then Destroy;
end;

procedure TSrmObject.SaveSrmFile;
begin
//写入更新后的文件头
with FFileHead do
begin
FileSeek(FFileHandle,0,0);
EditDate:=Now;
Key:=GetTickCount;
Encypher(Key,Password,3);
Encypher(Key,Author,4);
FileWrite(FFileHandle,FFileHead,sizeof(TFileHead));
Decypher(Key,Password,3);
Decypher(Key,Author,4);
end;
end;

class function TSrmObject.IsSrmFile(var Fn:string):boolean;
var
Fh: TFileHead;
Fs: TFileStream;
begin
Result:=false;
Fs:=TFileStream.Create(Fn,fmOpenRead);
//根据文件长度判断
with Fs do
begin
if (Size<(sizeof(TFileHead)+sizeof(TIndexHead))) then
begin
Free;
Result:=false;
Exit;
end;
Read(Fh,sizeof(TFileHead));
Free;
end;
//根据文件标志判断
with Fh do
begin
if ( (DataFlag[0]='K') and (DataFlag[1]='i') and
(DataFlag[2]='v') and (DataFlag[3]='e') and
(DataFlag[4]='n') ) then
Result:=true;
end;
end;

procedure TSrmObject.LoadIndex(Msh,Msd:TMemoryStream);
begin
//读出索引头
FileSeek(FFileHandle,FFileHead.IndexPos,0);
FileRead(FFileHandle,FIndexHead,sizeof(TIndexHead));
//处理索引长度为0的状况，否则读出具体索引
if (FIndexHead.Size=0) then
begin
Msh.SetSize(0);
Msd.SetSize(0);
end
else
begin
Msh.SetSize(FIndexHead.Size);
Msd.SetSize(FIndexHead.Count*sizeof(longint)*2);
FileRead(FFileHandle,Msh.Memory^,Msh.Size);
FileRead(FFileHandle,Msd.Memory^,Msd.Size);
Decypher(FIndexHead.Key,Msh.Memory^,Msh.Size div 4);
end;
end;

procedure TSrmObject.SaveIndex(Msh,Msd:TMemoryStream);
begin
if FChangeFlag then //增加过新内容时
FFileHead.IndexPos:=FileSeek(FFileHandle,0,2)
else //无新增内容
FileSeek(FFileHandle,FFileHead.IndexPos,0);
//设置数据头
with FIndexHead do
begin
Key:=GetTickCount;
Size:=Msh.Size;
Count:=Msd.Size div (sizeof(longint)*2);
end;
//加密标题内容
Encypher(FIndexHead.Key,Msh.Memory^,Msh.Size div 4);
//写入索引
FileWrite(FFileHandle,FIndexHead,sizeof(TIndexHead));
FileWrite(FFileHandle,Msh.Memory^,Msh.Size);
FileWrite(FFileHandle,Msd.Memory^,Msd.Size);
end;

procedure TSrmObject.ReadItemHead(Ps:longint);
begin
FActivePos:=Ps; //保存当前数据位置
//读出并解密
with FDataHead do
begin
FileSeek(FFileHandle,Ps,0);
FileRead(FFileHandle,FDataHead,sizeof(TDataHead));
Decypher(Key,SearchKey,13);
Decypher(Key,Author,4);
Decypher(Key,Password,3);
end;
end;

procedure TSrmObject.ReadItemData(DataStream:TMemoryStream);
var
size:longint;
begin
//读出具体内容
FileRead(FFileHandle,size,sizeof(longint));
DataStream.SetSize(size);
FileRead(FFileHandle,DataStream.Memory^,size);
Decypher(FDataHead.Key,DataStream.Memory^,size div 4);
end;

procedure TSrmObject.EditItemHead(Ps:longint);
begin
//修改数据头
FileSeek(FFileHandle,Ps,0);
with FDataHead do
begin
Encypher(Key,SearchKey,13);
Encypher(Key,Author,4);
Encypher(Key,Password,3);
FileWrite(FFileHandle,FDataHead,sizeof(TDataHead));
Decypher(Key,SearchKey,13);
Decypher(Key,Author,4);
Decypher(Key,Password,3);
end;
end;

function TSrmObject.AddItemHead:longint;
begin
//新内容增加时移到文件尾添加
FChangeFlag:=true;
with FDataHead do
begin
Result:=FileSeek(FFileHandle,0,2);
Key:=GetTickCount;
PubDate:=Now;
Encypher(Key,SearchKey,13);
Encypher(Key,Author,4);
Encypher(Key,Password,3);
FileWrite(FFileHandle,FDataHead,sizeof(TDataHead));
Decypher(Key,SearchKey,13);
Decypher(Key,Author,4);
Decypher(Key,Password,3);
end;
end;

procedure TSrmObject.AddItemData(DataStream:TMemoryStream);
var
size:longint;
begin
size:=DataStream.Size;
FileWrite(FFileHandle,size,sizeof(longint));
Encypher(FDataHead.Key,DataStream.Memory^,size div 4);
FileWrite(FFileHandle,DataStream.Memory^,size);
end;

function TSrmObject.GetItemPassword(Ps:longint):string; //得某标题口令
var
Dh:TDataHead;
begin
//读出并解密
with Dh do
begin
FileSeek(FFileHandle,Ps,0);
FileRead(FFileHandle,Dh,sizeof(TDataHead));
Decypher(Key,Password,3);
end;
result:=string(Dh.Password);
end;

procedure TSrmObject.SetDbChanged(Value:boolean);
begin
FDbChanged:=Value;
end;

procedure TSrmObject.SetIndexChanged(Value:boolean);
begin
FIndexChanged:=Value;
if Value then FDbChanged:=Value;
end;

procedure TSrmObject.SetItemHeadChanged(Value:boolean);
begin
FItemHeadChanged:=Value;
if Value then
begin
FIndexChanged:=Value;
FDbChanged:=Value;
end;
end;

procedure TSrmObject.SetItemDataChanged(Value:boolean);
begin
FItemDataChanged:=Value;
if Value then
begin
FIndexChanged:=Value;
FDbChanged:=Value;
end;
end;

end.

分享到：
| IP地址测试命令详解
评论
发表评论

您还没有登录,请您登录后再发表评论

相关推荐

    数据库access.rar

    Access是由微软公司开发的一款小型关系型数据库管理系统，它在个人和小型企业中广泛使用，尤其适合处理相对较小规模的数据存储和管理任务。Access以其易用性、灵活性和与Microsoft Office套件的无缝集成而著名。在...

    ASP与数据库，有用的代码（转贴，摘贴）

    根据提供的文件信息，本文将详细解析ASP与数据库结合进行密码验证的相关知识点，包括所需环境配置、工具选择以及具体实现步骤。...以上就是关于ASP与数据库结合进行密码验证的详细介绍，希望对初学者有所帮助。

    QTP数据库连接

    【转贴：完整的QTP数据库连接（以SQLSEVER例并有导出excel） 百度空间_应用平台.files】和【QTP手动连接SQL Server-DB2-Oracle数据库的方法 - gold_85的日志 - 网易博客.files】可能是包含示例代码或图片的附件，...

    易语言源码动网转贴.rar

    通过对《易语言源码动网转贴》的分析，我们可以学习到如何处理大型数据库迁移、如何设计数据转换逻辑、如何优化程序性能以及如何进行错误处理等多个方面的知识。对于易语言的学习者来说，这是一个宝贵的实践案例，...

    易语言动网转贴.rar

    总的来说，"易语言动网转贴"可能是一个结合了网络爬虫、数据解析、数据库操作等多个技术领域的项目。对于初学者，可以通过学习这个项目了解易语言的编程实践；对于有经验的开发者，它可以作为一个研究网络数据迁移和...

    动网转贴.e.rar

    【标题】"动网转贴.e.rar"是一个压缩文件，很可能包含了有关动网论坛或社区的相关资源、数据或用户帖子的备份。动网是中国早期知名的网络论坛软件之一，提供了丰富的社区功能，允许用户发帖、回帖、互动等。这个...

    senlon实用查询工具大全 v2014 本地数据库版.zip

    1、源码全部为本地数据库； 2、源码功能丰富，总计包括180项实用查询工具； 3、源码干净简洁，无广告纯净版； 4、适合任何网站使用，尤其是适用于网址导航、本地服务等类型的网站；   日常生活类查询： ...

    jquery的转贴功能实现

    总的来说，实现jQuery的转贴功能需要对DOM操作、事件处理、Ajax请求以及不同社交网络的API有深入理解。通过合理地组织代码和利用jQuery的功能，可以创建一个高效且易于维护的分享系统，提升网站的互动性和用户参与度...

    动易系统的论坛转贴工具

    总的来说，动易系统的论坛转贴工具是一款极具实用价值的软件，它简化了内容跨论坛分享的步骤，同时有助于提升网站的在线可见度。对于那些活跃于多个论坛的用户以及希望扩大网络影响力的网站管理员来说，这款工具无疑...

    Struts-menu源码分析(转贴).rar

    它简化了构建基于JSP和Servlet的Web应用的过程，通过提供一系列的控制器、标签库和验证框架来帮助开发者组织和管理代码。 2. **MVC模式**： MVC模式是软件工程中的一个设计模式，将业务逻辑（Model）、用户界面...

    转贴一个网络设计的例子

    转贴一个网络设计的例子

    动易系统的论坛转贴工具 -ASP源码.zip

    标题中的“动易系统的论坛转贴工具 -ASP源码.zip”揭示了这是一个基于ASP（Active Server Pages）编程语言开发的论坛转贴工具的源代码。ASP是微软公司推出的一种服务器端脚本环境，用于创建动态交互式网页。这个工具...

    Axis学习笔记(网页转贴)

    **Axis学习笔记(网页转贴)** Axis是一个开源的Java库，主要用于创建和使用Web服务。它是Apache软件基金会的一部分，广泛应用于开发基于SOAP（简单对象访问协议）的Web服务。本学习笔记将深入探讨Axis在Web服务开发...

    凹丫丫ASP.NET新闻系统学习（转贴）

    【凹丫丫ASP.NET新闻系统学习（转贴）】是一个基于Visual Studio 2005（VS2005）和SQL Server 2005的教程资源，旨在帮助开发者学习如何构建一个基本的新闻信息发布系统。这个系统可能涵盖了新闻的添加、编辑、删除...

    电子功用-导电胶配对模切对半转贴加工方法

    本篇将详细探讨“电子功用-导电胶配对模切对半转贴加工方法”，这是一种高效的生产工艺，旨在提高电子产品的性能和可靠性。 导电胶主要由导电填料（如金属颗粒）、树脂基体和添加剂组成。它的特性在于既能保持良好...

    动网转贴.zip易语言项目例子源码下载

    这个名为“动网转贴”的项目，是易语言编程实践中一个典型的例子，它为学习者提供了宝贵的实践素材，无论你是个人学习、学生毕业设计还是小团队的项目开发，都能从中获取灵感和参考。 首先，我们要理解易语言的核心...

    BFC UBB转贴器

    这是一个类似论坛转贴工具的小程序，可以将剪贴板中的HTML代码转换为论坛支持的UBB代码。 由于现在流行的转贴工具都是基于浏览器的，转换速度比较慢，还得打开浏览器才能使用（同时受到浏览器版本限制）。 &lt;br...

    [转贴]彻底学通string.Format以及IFormattable,IFormatProvider,ICustomFormatter

    本篇将深入探讨`string.Format`以及与其相关的接口`IFormattable`、`IFormatProvider`和`ICustomFormatter`，帮助你彻底理解它们的工作原理和使用场景。 首先，`string.Format`方法的语法如下： ```csharp public ...

Magicbox
Global site tag (gtag.js) - Google Analytics