unit uDMMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBClient, DynamicNS_D3, HTTPApp;
const
MSG_NEEDSAVE = '当前文件已经更改，需要保存吗？';
TIT_NEEDSAVE = '文件已经改变';
BTN_NEEDSAVE = MB_YESNOCANCEL + MB_ICONQUESTION;
MSG_SAVEFAIL = '保存文件错误，当前数据未能正确保存。';
TIT_SAVEFAIL = '文件系统错误';
BTN_SAVEFAIL = MB_OK + MB_ICONERROR;
MSG_OPENFAIL = '文件错误，无法打开指定的的文件。';
TIT_OPENFAIL = '文件系统错误';
BTN_OPENFAIL = MB_OK + MB_ICONERROR;
HTML_ERR = '<HTML><BODY>数据错误。</BODY></HTML>';
type
TdmMain = class(TDataModule)
Dataset: TClientDataSet;
DataSource: TDataSource;
DatasetURL: TStringField;
DatasetContent: TBlobField;
OD: TOpenDialog;
SD: TSaveDialog;
procedure DatasetAfterOpen(DataSet: TDataSet);
procedure DatasetAfterPost(DataSet: TDataSet);
procedure dmMainCreate(Sender: TObject);
private
{ Private declarations }
FModified : Boolean;
FRootURL : String;
function CanCloseData : Boolean;
procedure UpdateUI;
//Accept确定是否处理传递的URL请求
procedure Accept(const URL:String;var Accept:Boolean);
//被Accept通过的URL通过Content输出到
procedure Content(const URL:String;var Stream:TStream);
procedure DefaultContent(var Stream:TStream);
public
{ Public declarations }
property Modified : Boolean read FModified;
property RootURL : String read FRootURL;
function SaveData : Boolean;
function OpenData : Boolean;
procedure NewData;
end;
var
dmMain: TdmMain;
implementation
uses uMain;
{$R *.DFM}
procedure TdmMain.Accept(const URL:String;var Accept:Boolean);
begin
Accept := Pos(FRootURL,URL) = 1;
end;
procedure TdmMain.DefaultContent(var Stream:TStream);
var
SS : TStringStream;
begin
SS := TStringStream.Create(HTML_ERR);
SS.Position := 0;
try
Stream.CopyFrom(SS,SS.Size);
finally
SS.Free;
end;
end;
//这个程序所填充的内容，都来自数据库
procedure TdmMain.Content(const URL:String;var Stream:TStream);
begin
if not Dataset.Active then
DefaultContent(Stream)
else
begin
if Dataset.Locate('URL',Copy(HTTPDecode(URL),Length(FRootURL)+1,Length(HTTPDecode(URL))),[]) then
begin
DatasetContent.SaveToStream(Stream);
end
else
begin
DefaultContent(Stream);
end;
end;
if Stream.Size < 1 then DefaultContent(Stream);
end;
function TdmMain.CanCloseData:Boolean;
var
RT : Integer;
begin
Result := False;
if Self.FModified then
begin
RT := MessageBox(Forms.Application.Handle,MSG_NEEDSAVE,TIT_NEEDSAVE,BTN_NEEDSAVE);
case RT of
IDCANCEL : Exit;
IDNO : Result := True;
IDYES : Result := SaveData;
end;
end
else
Result := True;
end;
function TdmMain.SaveData:Boolean;
begin
Result := False;
if SD.FileName = '' then
if not SD.Execute then Exit;
try
Dataset.SaveToFile(SD.Filename);
Result := True;
except
MessageBox(Forms.Application.Handle,MSG_SAVEFAIL,TIT_SAVEFAIL,BTN_SAVEFAIL);
end;
FModified := False;
UpdateUI;
end;
function TdmMain.OpenData:Boolean;
begin
if not Self.CanCloseData then Exit;
Result := False;
if OD.Execute then
try
Dataset.LoadFromFile(OD.Filename);
Result := True;
SD.FileName := OD.FileName;
except
MessageBox(Forms.Application.Handle,MSG_OPENFAIL,TIT_OPENFAIL,BTN_OPENFAIL);
end;
end;
procedure TdmMain.NewData;
begin
if not CanCloseData then Exit;
Dataset.Active := False;
Dataset.CreateDataSet;
OD.FileName := '';
SD.FileName := '';
end;
procedure TdmMain.DatasetAfterOpen(DataSet: TDataSet);
begin
Self.FModified := False;
UpdateUI;
end;
procedure TdmMain.DatasetAfterPost(DataSet: TDataSet);
begin
Self.FModified := True;
UpdateUI;
end;
procedure TdmMain.dmMainCreate(Sender: TObject);
begin
//初始化时，将DynamicProtocal激活
//设定协议名为http，这样进程内所有的http协议就会被截获。
//协议名可以自由定义，比如myprotocal
DynamicProtocol.ProtocolName := 'http';
DynamicProtocol.Enabled := True;
//此处绑定事件处理程序
DynamicProtocol.OnAccept := Self.Accept;
DynamicProtocol.OnGetContent := Self.Content;
FRootURL := 'http://testsite/';
NewData;
end;
procedure TdmMain.UpdateUI;
begin
if Dataset.Active then
begin
fMain.btnSave.Enabled := FModified;
fMain.btnAdd.Enabled := True;
fMain.btnDel.Enabled := Dataset.RecordCount > 0;
fMain.btnClear.Enabled := fMain.btnDel.Enabled;
fMain.btnFile.Enabled := True;
end
else
begin
fMain.btnSave.Enabled := False;
fMain.btnAdd.Enabled := False;
fMain.btnDel.Enabled := False;
fMain.btnClear.Enabled := False;
fMain.btnFile.Enabled := False;
end;
end;
end.
| -ICP -IDC -ISP |