servereatdm.pas

东华休闲山庄洗浴、餐饮、客房管理系统

unit ServerEatDM;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, ServerEat_TLB, StdVcl, ADODB, DB, Provider;

type
  TEat = class(TRemoteDataModule, IEat)
    qryRoom: TADOQuery;
    dspRoom: TDataSetProvider;
    conDBRoom: TADOConnection;
    dsRoomConsume: TADODataSet;
    dspRoomConsume: TDataSetProvider;
    dsRoomLog: TADODataSet;
    dspRoomLog: TDataSetProvider;
    dsRoomRoomPeople: TADODataSet;
    dspRoomRoomPeople: TDataSetProvider;
    dsRoomRoomSelect: TADODataSet;
    dspRoomRoomSelect: TDataSetProvider;
    dsRoomGuest: TADODataSet;
    dspRoomGuest: TDataSetProvider;
    dsRoomReserve: TADODataSet;
    dspRoomReserve: TDataSetProvider;
    dsRoomXFXMSelect: TADODataSet;
    dspRoomXFXMSelect: TDataSetProvider;
    dsRoomHouseTemp: TADODataSet;
    dspRoomHouseTemp: TDataSetProvider;
    dsRoomHouseTest: TADODataSet;
    dspRoomHouseTest: TDataSetProvider;
    dsRoomYJGL: TADODataSet;
    dspRoomYJGL: TDataSetProvider;
    dsRoomBKJZ: TADODataSet;
    dspRoomBKJZ: TDataSetProvider;
    dsRoomHouse: TADODataSet;
    dspRoomHouse: TDataSetProvider;
    dsRoomRoom: TADODataSet;
    dspRoomRoom: TDataSetProvider;
    dsRoomRoomtype: TADODataSet;
    dspRoomRoomtype: TDataSetProvider;
    dsRoomXFXM: TADODataSet;
    dspRoomXFXM: TDataSetProvider;
    dsRoomXMLX: TADODataSet;
    dspRoomXMLX: TDataSetProvider;
    dsRoomGuestSource: TADODataSet;
    dspRoomGuestSource: TDataSetProvider;
    dsUser: TADODataSet;
    dspUser: TDataSetProvider;
    dsGroups: TADODataSet;
    dspGroups: TDataSetProvider;
    dsDepart: TADODataSet;
    dspDepart: TDataSetProvider;
    dsServer: TADODataSet;
    dspServer: TDataSetProvider;
    procedure RemoteDataModuleCreate(Sender: TObject);
    procedure RemoteDataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure DBBackup(out v_result: OleVariant); safecall;
    procedure DBClose(out v_result: OleVariant); safecall;
    procedure DBOpen(out v_result: OleVariant); safecall;
    procedure DBRecovery(out v_result: OleVariant); safecall;
  public
    { Public declarations }
    function DataBackup(NewFileName:string):boolean;//数据备份
    function DataRecovery(NewFileName:string):boolean;//数据恢复
    procedure ErrorInformation(errorinfo:string);//记录当前错误信息
  end;

implementation

uses ServerEatUnit;

{$R *.DFM}

class procedure TEat.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;

function TEat.DataBackup(NewFileName:string):boolean;
var
  Source,Destination:tfilestream;
  buffer:pchar;
  fsize:int64;
begin
  Source:=nil;
  Destination:=nil;
  result:=false;
  try
    try
      Source:=tfilestream.Create(ServerEatForm.SoftPath+'DataBase\eat.mdb',fmOpenRead);
      Destination:=tfilestream.Create(NewFileName+'\eat.mdb',fmCreate);
      fsize:=Source.Size;
      buffer:=allocmem(fsize);
      source.Read(buffer^,fsize);
      Destination.Write(buffer^,fsize);
    except
      result:=true;
    end;
  finally
    Destination.Free;
    Source.Free;
  end;
end;

function TEat.DataRecovery(NewFileName:string):boolean;
var
  Source,Destination:tfilestream;
  buffer:pchar;
  fsize:int64;
begin
  Source:=nil;
  Destination:=nil;
  result:=false;
  try
    try
      Source:=tfilestream.Create(NewFileName+'\eat.mdb',fmOpenRead);
      Destination:=tfilestream.Create(ServerEatForm.SoftPath+'DataBase\eat.mdb',fmCreate);
      fsize:=Source.Size;
      buffer:=allocmem(fsize);
      source.Read(buffer^,fsize);
      Destination.Write(buffer^,fsize);
    except
      result:=true;
    end;
  finally
    Destination.Free;
    Source.Free;
  end;
end;

procedure TEat.ErrorInformation(errorinfo:string);
var
  NewFileName:string;
  txt:textfile;
begin
  NewFileName:=ServerEatForm.SoftPath+'Error';
  if not DirectoryExists(NewFileName) then
    MkDir(NewFileName);
  NewFileName:=NewFileName+'\ErrorInfo.txt';
  assignfile(txt,NewFileName);
  if not FileExists(NewFileName) then
    rewrite(txt)
  else
    append(txt);
  writeln(txt,errorinfo);
  closefile(txt);
end;

procedure TEat.DBBackup(out v_result: OleVariant);
var
  NewFileName:string;
  temp:string;
begin
  self.conDBRoom.Connected:=false;
  NewFileName:=ServerEatForm.SoftPath+'Backup';
  if not DirectoryExists(NewFileName) then
    MkDir(NewFileName);
  if fileexists(NewFileName+'\eat.mdb') then
    deletefile(NewFileName+'\eat.mdb');
  if DataBackup(NewFileName) then
    temp:='数据备份时出现错误,请重新操作！'
  else
    temp:='数据备份成功！';
  self.conDBRoom.Connected:=true;
  v_result:=temp;
end;

procedure TEat.DBClose(out v_result: OleVariant);
var
  info:string;
begin
  try
    if self.conDBRoom.Connected then
      self.conDBRoom.Connected:=false ;
    v_result:='';
  except
    on e:exception do
      begin
        info:='***********************************************'+#13#10;
        info:=info+'错误时间:'+datetimetostr(now)+#13#10;
        info:=info+'错误信息:'+e.Message+#13#10;
        info:=info+'***********************************************'+#13#10;
        ErrorInformation(info);
        v_result:='服务器端断开数据库连接时出现错误，请与开发人员联系！';
      end;
  end;
end;

procedure TEat.DBOpen(out v_result: OleVariant);
var
  connstr,info:string;
begin
  try
    connstr:='Provider=Microsoft.Jet.OLEDB.4.0;'+
             'Data Source='+ServerEatForm.SoftPath+'DataBase\eat.mdb;'+
             'Persist Security Info=False';
    self.conDBRoom.Connected:=false;
    self.conDBRoom.ConnectionString:=connstr;
    self.conDBRoom.Connected:=true;
    v_result:='';
  except
    on e:exception do
      begin
        info:='***********************************************'+#13#10;
        info:=info+'错误时间:'+datetimetostr(now)+#13#10;
        info:=info+'错误信息:'+e.Message+#13#10;
        info:=info+'***********************************************'+#13#10;
        ErrorInformation(info);
        v_result:='服务器端连接数据库时出现错误，请与开发人员联系！';
      end;
  end;
end;

procedure TEat.DBRecovery(out v_result: OleVariant);
var
  NewFileName:string;
  srec:tsearchrec;
  temp:string;
begin
  self.conDBRoom.Connected:=false;
  NewFileName:=ServerEatForm.SoftPath+'Backup';
  if not DirectoryExists(NewFileName) then
    temp:='恢复目录不存在,请先执行数据备份！'
  else
    if not fileexists(NewFileName+'\Eat.mdb') then
      temp:='恢复目录下数据库文件不存在,请先执行数据备份！'
    else
      begin
        deletefile(ServerEatForm.SoftPath+'DataBase\Eat.mdb');
        if DataRecovery(NewFileName) then
          temp:='数据恢复时出现错误,请重新操作！'
        else
          if findfirst(NewFileName+'\Eat.mdb',faanyfile,srec)=0 then
            temp:='数据恢复成功,已恢复到'+datetimetostr(filedatetodatetime(srec.time))+'！'
          else
            temp:='数据恢复时数据库文件不存在,请重新操作！';
      end;
  self.conDBRoom.Connected:=true;
  v_result:=temp;
end;

procedure TEat.RemoteDataModuleCreate(Sender: TObject);
begin
  ServerEatForm.getclientcount(1);
end;

procedure TEat.RemoteDataModuleDestroy(Sender: TObject);
begin
  ServerEatForm.getclientcount(-1);
end;

initialization
  TComponentFactory.Create(ComServer, TEat,
    Class_Eat, ciMultiInstance, tmNeutral);
end.