datam.pas

这是一个DELPHI7应用案例开发篇有配套程序种子光盘

unit DataM;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, AppServer_TLB, StdVcl, DBXpress, FMTBcd, Provider, DB, SqlExpr,
  Variants;

type
  TBookAppServ = class(TRemoteDataModule, IBookAppServ)
    SQLConnection1: TSQLConnection;
    qrBookBySerial: TSQLQuery;
    dpBookBySerial: TDataSetProvider;
    tbBook: TSQLTable;
    dpBook: TDataSetProvider;
    tbBuy1: TSQLTable;
    tbBuy2: TSQLTable;
    dsBuy2: TDataSource;
    dpBuy: TDataSetProvider;
    dpTmpBuy1: TDataSetProvider;
    tbBuy2BuySerial: TIntegerField;
    tbBuy2BuyDate: TDateField;
    tbBuy2Memoir: TMemoField;
    cdsTmpBuy1: TClientDataSet;
    cdsTmpBuy1BookSerial: TStringField;
    cdsTmpBuy1BookCount: TBCDField;
    cdsTmpBuy1TotalPrice: TBCDField;
    tbBuy1BuySerial: TIntegerField;
    tbBuy1BookSerial: TStringField;
    tbBuy1BookCount: TBCDField;
    tbBuy1TotalPrice: TBCDField;
    tbUser: TSQLTable;
    dpUser: TDataSetProvider;
    tbCustomer: TSQLTable;
    dpCustomer: TDataSetProvider;
    procedure RemoteDataModuleCreate(Sender: TObject);
    procedure RemoteDataModuleDestroy(Sender: TObject);
  private

  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure AddBuyItem(BuyDate: TDateTime; const Memoir: WideString);
      safecall;
    function Login(const UserName, Password: WideString): OleVariant; safecall;
  public
    fUserName : String;
    fPassword : String;
    fPriv: Integer; {1:超级用户，2：普通用户}
  end;

implementation

uses Main;

{$R *.DFM}

class procedure TBookAppServ.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;

procedure TBookAppServ.AddBuyItem(BuyDate: TDateTime;
  const Memoir: WideString);
var
    i,n:Integer;
    ABookSerial : String;
    SQLs : array [0..8] of String;
    tmpS: String;
    qrAddBook : TSQLQuery;
    AbuySerial:Integer;
    ABookCount : Integer;
begin
    //检查数据的有效性
    n := cdsTmpBuy1.RecordCount;
    if n=0 then
        raise Exception.Create('Lack of book record');

    cdsTmpBuy1.First;
    for i:=0 to n-1 do
    begin
        ABookSerial := cdsTmpBuy1.FieldByName('BookSerial').AsString;

        tbBook.Open;
        if VarType(tbBook.Lookup('BookSerial',ABookSerial,
            'BookSerial')) in [varNULL] then
        begin
            raise Exception.Create(Format('"No.%d BookSerial" is not correct!',[cdsTmpBuy1.RecNo]));
        end;
        cdsTmpBuy1.Next;
    end;

    //开始更新数据
    SQLs[0] := 'LOCK TABLES tb_buy1 WRITE, tb_buy2 WRITE, tb_store WRITE';
    SQLs[1] := 'INSERT INTO tb_buy2 VALUES (NULL,'''+FormatDateTime(
        'yyyy-mm-dd',BuyDate)+''','''+ Memoir+''')';
    SQLs[2] := 'SELECT MAX(BuySerial) from tb_buy2';
    SQLs[3] := 'INSERT INTO tb_buy1 VALUES ';
    SQLs[4] := '(%d,''%s'',%s,%s)';
    SQLs[5] := 'SELECT * FROM tb_store where BookSerial=''%s''';
    SQLs[6] := 'INSERT INTO tb_store VALUES (''%s'',%d, NULL)';
    SQLs[7] := 'UPDATE tb_store SET BookCount=BookCount+%d WHERE BookSerial=''%s''';
    SQLs[8] := 'UNLOCK TABLES';

    qrAddBook := TSQLQuery.Create(Self);
    qrAddBook.SQLConnection := SQLConnection1;

    qrAddBook.SQL.Text := SQLs[0];
    qrAddBook.ExecSQL(True);
    qrAddBook.SQL.Text := SQLs[1];
    qrAddBook.ExecSQL(True);
    
    qrAddBook.SQL.Text := SQLs[2];
    qrAddBook.Open;
    ABuySerial := qrAddBook.Fields[0].AsInteger;

    tmpS := SQLs[3];
    cdsTmpBuy1.First;
    for i:=0 to n-1 do
    begin
        tmpS := tmpS+Format(SQLs[4],[ABuySerial,
            cdsTmpBuy1.FieldByName('BookSerial').AsString,
            cdsTmpBuy1.FieldByName('BookCount').AsString,
            cdsTmpBuy1.FieldByName('TotalPrice').AsString])+',';
        cdsTmpBuy1.Next;
    end;
    SetLength(tmpS,Length(tmpS)-1); //去掉最后的逗号

    qrAddBook.SQL.Text := tmpS;
    qrAddBook.ExecSQL(True);

    //更新库存表
    cdsTmpBuy1.First;
    for i:=0 to n-1 do
    begin
        ABookSerial := cdsTmpBuy1.FieldByName('BookSerial').AsString;
        ABookCount := cdsTmpBuy1.FieldByName('BookCount').AsInteger;
        tmpS := Format(SQLs[5],[ABookSerial]);
        qrAddBook.SQL.Text := tmpS;
        qrAddBook.Open;

        //如果书籍第一次进货
        if qrAddBook.RecordCount=0 then
        begin
            qrAddBook.Close;
            tmpS := Format(SQLs[6],[ABookSerial,ABookCount]);
            qrAddBook.SQL.Text := tmpS;
            qrAddBook.ExecSQL(True);
        end
        else    //如果书籍已经存在库中
        begin
            qrAddBook.Close;
            tmpS := Format(SQLs[7],[ABookCount,ABookSerial]);
            qrAddBook.SQL.Text := tmpS;
            qrAddBook.ExecSQL(True);
        end;
    end;

    qrAddBook.SQL.Text := SQLs[8];
    qrAddBook.ExecSQL(True);

    qrAddBook.Free;
end;

function TBookAppServ.Login(const UserName,
  Password: WideString): OleVariant;
var
    qrUser:TSQLQuery;
begin
    qrUser := TSQLQuery.Create(Self);
    qrUser.SQLConnection := SQLConnection1;

    qrUser.SQL.Text := 'SELECT Priv FROM tb_user WHERE ID='''+
        UserName+''' and Passwd='''+Password+'''';
    qrUser.Open;
    if qrUser.RecordCount>0 then
    begin
        qrUser.First;
        fPriv := qrUser.Fields[0].AsInteger;
        fUserName := UserName;
        fPassword := Password;
        qrUser.Free;
        Result := fPriv;        
    end
    else
    begin
        qrUser.Free;
        raise Exception.Create('用户名和密码错误');
    end;

    frmMain.Memo1.Lines.Add(fUserName+' login at '+
        FormatDateTime('yyyy-mm-dd hh-mm-ss',Now));
end;

procedure TBookAppServ.RemoteDataModuleCreate(Sender: TObject);
begin
    with frmMain do
    begin
        Inc(Connects);
        lbConnects.Caption := IntToStr(Connects);
    end;
end;

procedure TBookAppServ.RemoteDataModuleDestroy(Sender: TObject);
begin
    with frmMain do
    begin
        Dec(Connects);
        lbConnects.Caption := IntToStr(Connects);

        Memo1.Lines.Add(fUserName+' logout at '+
            FormatDateTime('yyyy-mm-dd hh-mm-ss',Now));
    end;
end;

initialization
  TComponentFactory.Create(ComServer, TBookAppServ,
    Class_BookAppServ, ciMultiInstance, tmApartment);
end.