Typing & Coding & Bugging

2011年7月7日星期四

非匿名方式访问远程的COM+

COM+的部署一直是个非常头疼的事情，往往在同一台电脑上开发客户端和应用层端时，运行的好好的，可是一旦把客户端部署到其它电脑上去，麻烦就接踵而来。

今天要讨论的只是其中的一个经常会遇到的麻烦：“拒绝访问”，通常发生这种问题的原因是客户端调用者的身份不符合服务器端的要求，因此需要修改服务器端的验证规则，或者在客户端提交连接时，将服务器端的帐户提供给服务器，而不是想往常那样简单的置为NULL。

{重载连接方法}

unit uJZCom;

interface

uses windows, comobj, activex;

type

    pUnShort = ^Word;

    pCoAuthIdentity = ^_CoAuthIdentity;

    _CoAuthIdentity = record
        user: PWideChar;
        UserLength: ULONG;
        Domain: PWideChar;
        DomainLength: ULONG;
        password: PWideChar;
        PasswordLength: ULONG;
        Flags: ULONG;
    end;

    _CoAuthInfo = record
        dwAuthnSvc: DWORD;
        dwAuthzSvc: DWORD;
        pwszServerPrincName: PWideChar;
        dwAuthnLevel: DWORD;
        dwImpersonationLevel: DWORD;
        pAuthIdentityData: pCoAuthIdentity;
        dwCapabilities: DWORD;
    end;

Function MySetBlanket(var itf: IUnknown; const vCai: _CoAuthInfo): HRESULT;
function DoConnect(const Class_IID, itf_iid: PIID;
    computer, username, psw: WideString): IUnknown;

implementation

uses
    SysUtils,
    StrUtils;

Function MySetBlanket(var itf: IUnknown; const vCai: _CoAuthInfo): HRESULT;
begin
    with vCai do
    begin
        result := CoSetProxyBlanket(itf, dwAuthnSvc, dwAuthzSvc,
            PWideChar(pAuthIdentityData^.Domain), dwAuthnLevel,
            dwImpersonationLevel, pAuthIdentityData, dwCapabilities);
    end;
end;

function DoConnect(const Class_IID, itf_iid: PIID;
    computer, username, psw: WideString): IUnknown;
var
    FCai: _CoAuthInfo;
    FCid: _CoAuthIdentity;
    FSvInfo: COSERVERINFO;
    Mqi: MULTI_QI;
    Size: DWORD;
    LocalMachine: array [0 .. MAX_COMPUTERNAME_LENGTH] of char;
begin
    result := nil;
    if Length(computer) > 0 then
    begin
        Size := sizeof(LocalMachine);
        if GetComputerName(LocalMachine, Size) and
            (UpperCase(computer) <> UpperCase(LocalMachine)) then
        // 电脑名称比较时大小写敏感
        begin
            FillMemory(@FCai, sizeof(FCai), 0);
            FillMemory(@FCid, sizeof(FCid), 0);
            FillMemory(@FSvInfo, sizeof(FSvInfo), 0);
            with FCid do
            begin
                user := PWideChar(username); // pUnshort(@userName[1]);
                UserLength := Length(username);
                Domain := PWideChar(computer); // pUnshort(@computer[1]);
                DomainLength := Length(computer);
                password := PWideChar(psw); // pUnShort(@psw[1]);
                PasswordLength := Length(psw);
                Flags := 2; // Unicode 字符串
            end;
            with FCai do
            begin
                dwAuthnSvc := 10; // RPC_C_AUTHN_WINNT NTML认证服务
                dwAuthzSvc := 0; // RPC_C_AUTHZ_NONE
                dwAuthnLevel := 0; // RPC_C_AUTHN_LEVEL_DEFAULT 默认级别

                dwImpersonationLevel := 3; // 身份模拟
                pAuthIdentityData := @FCid;
                dwCapabilities := $0800; // 静态跟踪
            end;
            FSvInfo.pwszName := PWideChar(computer);
            FSvInfo.pAuthInfo := @FCai;

            with Mqi do
            begin
                iid := itf_iid;
                itf := nil;
                hr := 0;
            end;
            // 以远程用户身份激活并取得接口引用
            olecheck(CoCreateInstanceEx(Class_IID^, nil, CLSCTX_REMOTE_SERVER,
                    @FSvInfo, 1, @Mqi));
            olecheck(Mqi.hr);
            // 对取得的接口引用，要再次设置其安全属性为远程用户，否则返回的指针将仍然
            // 使用本地用户进程的安全属性向远程发起调用，此时的结果就是"拒绝访问"
            olecheck(MySetBlanket(Mqi.itf, FCai));
            result := Mqi.itf;
        end
        else // 原文遗漏，造成客户端与服务器端在同一台电脑上时，出现AV错误
            olecheck(CoCreateInstance(Class_IID^, nil,
                    CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, itf_iid^,
                    result));
    end
    else
        olecheck(CoCreateInstance(Class_IID^, nil,
                CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, itf_iid^,
                result));
end;

end.

客户端调用方法：

procedure TForm1.Button1Click(Sender: TObject);
begin
    svr := IBizRules(DoConnect(@class_bizrules, @iid_ibizrules, 'WINSEVEn',
            'admin', '******'));
    ClientDataSet1.Data := svr.GetEmployees;
    ClientDataSet1.Open;
end;

2011年7月3日星期日

唉，MIDAS

接着前面那篇关于三层的博客。

那个仓库管理模型：服务器端采用Remote Transactional Datamodule +TClientDataset，客户端采用TSocketConnection连接，所有窗体共享主窗体上面的SocketConnection。当这三层全部安装在同一台电脑上面时，运行良好，但是如果将应用层和表示层分别安装在不同电脑上面时，设计期还可以通过数据绑定控件查看服务器端传来的数据，但是运行的时候，同时只能有一个活动连接，并且更离谱的是，当CDS断开再连接时，便会抛出“拒绝连接”的错误。

我在客户端所在的电脑上，用D7重写了demo程序，依然是共享一个SocketConnection，在三个不同的窗体中，演示了主从关系、Lookup查询以及向服务器提交变动等，一切正常！

2011年7月2日星期六

Arduino离我还有多远

Arduino是一款开源硬件产品，比较适合像我这类小白菜，本来打算入手一个，连东西都放进购物车了的，结帐时候才发现，数字证书已经在几个月之前失效。:(

这个是从网上找来的Arduino Mega 1280的参数

Arduino MEGA 规格参数：
1.微控制器核心：ATmega1280-16AU
2.工作电压：+5V
3.外部输入电压：＋7V～＋12V（建议）
4.外部输入电压（极值）：+6V≤Vin≤＋20V
5.数字信号I/O接口：54（其中14个PWM输出接口）
6.模拟信号输入接口：16
7.DC I/O接口电流：40 mA
7.Flash容量：128 KB (其他4K用于bootloader)
8.SRAM静态存储容量：8KB
9.EEPROM存储容量：4KB
10.时钟频率：16MHz

下面是一些值得去的网站：
www.arduino.cc

仓库管理模型中采购计划的计算过程

最近帮人做了一个仓库管理的模型，本来是打算用库存表，在入库/出库操作时，同步更新库存表，考虑模型的数据量不是很大，于是采用动态计算的方式来生成采购计划。

在物料表中，有字段记录物料的最低安全库存/最高安全库存，由于时间的关系，设计时并没有真正考虑最高安全库存，特此说明一下。

数据库为MS SQL Server，在2000/2008上测试通过。

为了简化设计难度，增加脚本的可读性，计算过程分成两步，第一步进行汇总：

SELECT     p.ItemRef, p.ItemName, p.Price, p.LowerQTY, p.UpperQTY, p.SecurityQTY, p.UOMs_Ref, ISNULL(o.OutQTY, 0) AS OutQTY, ISNULL(i.InQTY, 0) AS InQTY,
                      ISNULL(i.InQTY, 0) - ISNULL(o.OutQTY, 0) AS BalanceQTY, dbo.UOMs.UOMName
FROM         dbo.Products AS p INNER JOIN
                      dbo.UOMs ON p.UOMs_Ref = dbo.UOMs.Ref LEFT OUTER JOIN
                      dbo.vInQTY AS i ON p.ItemRef = i.ItemRef LEFT OUTER JOIN
                      dbo.vOutQTY AS o ON p.ItemRef = o.ItemRef

第二步根据安全库存设置计算采购计划：

SELECT     dbo.vStockSum.ItemRef, dbo.vStockSum.ItemName, dbo.vStockSum.LowerQTY, dbo.vStockSum.UpperQTY, dbo.vStockSum.SecurityQTY, dbo.vStockSum.BalanceQTY,
                       dbo.vStockSum.BalanceQTY - dbo.vStockSum.LowerQTY AS L, ABS(dbo.vStockSum.BalanceQTY - dbo.vStockSum.LowerQTY) AS PurchasePlan,
                      dbo.vStockSum.UOMs_Ref, dbo.UOMs.UOMName
FROM         dbo.vStockSum INNER JOIN
                      dbo.UOMs ON dbo.vStockSum.UOMs_Ref = dbo.UOMs.Ref
WHERE     (dbo.vStockSum.BalanceQTY - dbo.vStockSum.LowerQTY < 0)

Dephi三层de迷惑

最近用D7写了一个三层数据库模型，使用了Remote Transactional Datamodule和TClientDataset组件，连接方式是SocketConnection。本来一开始运行的好好的，可是在服务器端程序改动一点点之后，便开始不正常，客户端访问的时候，抛出致命错误，也不知道致命在哪里。下面两段源代码经过比较，没发现有什么特别的改动。

{Code 1: 能够正常运行的代码}

unit uRead;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
    Windows,
    {.....}
    MidLayer_TLB,
    DB,
    ADODB,
    Provider;
type
    TReadFromDatabase = class(TMtsDataModule, IReadFromDatabase)
        conRead: TADOConnection;
        tblViewEmployees: TADOTable;
        cdsEmployees: TClientDataSet;
        dspEmployees: TDataSetProvider;
         {...}
    private
        { Private declarations }
    protected
        class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID:
            string); override;
        procedure PrepareEmployees; safecall;
        procedure Login; safecall;
        function SignIn(const ARef, APassword: WideString; ATimes: Integer;
            var AAdmin, ALogedSuccess, ARejected: WordBool): WideString;
            safecall;
    public
        { Public declarations }
    end;
var
    ReadFromDatabase: TReadFromDatabase;
implementation
uses
    IniFiles;
{$R *.DFM}
class procedure TReadFromDatabase.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 TReadFromDatabase.PrepareEmployees;
begin
    //reserved
end;
procedure TReadFromDatabase.Login;
begin
    //reserved
end;
function TReadFromDatabase.SignIn(const ARef, APassword: WideString;
    ATimes: Integer; var AAdmin, ALogedSuccess,
    ARejected: WordBool): WideString;
begin
    with TADOQuery.Create(nil) do
        try
            Connection := conRead;
            SQL.Add('SELECT Admin, FullName FROM Employees WHERE EmployeeRef=' +
                QuotedStr(ARef) + ' AND Password=' + QuotedStr(APassword));
            Open;
            if Eof then
                begin
                    Inc(ATimes);
                    ALogedSuccess := False;
                    if ATimes = 3 then
                        ARejected := True
                    else
                        ARejected := False;
                    AAdmin := False;
                    Result := '';
                end
            else
                begin
                    ALogedSuccess := True;
                    ARejected := False;
                    AAdmin := FieldByName('admin').AsBoolean;
                    Result := fieldbyname('FullName').AsString;
                end;
        finally
            Close;
            Free;
        end;
end;
initialization
    TComponentFactory.Create(ComServer, TReadFromDatabase,
        Class_ReadFromDatabase, ciMultiInstance, tmBoth);
end.

{Code 2: 运行不了的代码}
unit uRead;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
    {...}
    MidLayer_TLB,
    DB,
    ADODB,
    Provider;
type
    TReadFromDatabase = class(TMtsDataModule, IReadFromDatabase)
        tblViewEmployees: TADOTable;
        cdsEmployees: TClientDataSet;
        dspEmployees: TDataSetProvider;
        {...}
       conRead: TADOConnection;
        procedure MtsDataModuleCreate(Sender: TObject);
    private
        { Private declarations }
    protected
        class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID:
            string); override;
        procedure PrepareEmployees; safecall;
        procedure Login; safecall;
        function SignIn(const ARef, APassword: WideString; ATimes: Integer;
            var AAdmin, ALogedSuccess, ARejected: WordBool): WideString;
            safecall;
    public
        { Public declarations }
        constructor Create(AOwner: TComponent); override;
    end;
var
    ReadFromDatabase: TReadFromDatabase;
implementation
uses
    IniFiles,
    uLog;
{$R *.DFM}
class procedure TReadFromDatabase.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 TReadFromDatabase.PrepareEmployees;
begin
    //reserved
end;
procedure TReadFromDatabase.Login;
begin
    //reserved
end;
function TReadFromDatabase.SignIn(const ARef, APassword: WideString;
    ATimes: Integer; var AAdmin, ALogedSuccess,
    ARejected: WordBool): WideString;
begin
    with TADOQuery.Create(nil) do
        try
            if not conRead.Connected then
              conRead.Open();
            Connection := conRead;
            SQL.Add('SELECT Admin, FullName FROM Employees WHERE EmployeeRef=' +
                QuotedStr(ARef) + ' AND Password=' + QuotedStr(APassword));
            Open;
            if Eof then
                begin
                    Inc(ATimes);
                    ALogedSuccess := False;
                    if ATimes = 3 then
                        ARejected := True
                    else
                        ARejected := False;
                    AAdmin := False;
                    Result := '';
                end
            else
                begin
                    ALogedSuccess := True;
                    ARejected := False;
                    AAdmin := FieldByName('admin').AsBoolean;
                    Result := fieldbyname('FullName').AsString;
                end;
        finally
            Close;
            Free;
        end;
end;
constructor TReadFromDatabase.Create(AOwner: TComponent);
begin
end;
procedure TReadFromDatabase.MtsDataModuleCreate(Sender: TObject);
var
    Loger           : TLoger;
    msg             : WideString;
begin
//    if conRead.Connected then
//        msg := FormatDateTime('mm-dd hh:nn:ss', Now) + ': Opened on ' +
//            conRead.ConnectionString
//    else
//        msg := FormatDateTime('mm-dd hh:nn:ss', Now) + ': is closed ';
//    Loger.Log(msg);
//    ShowMessage(msg);
end;
initialization
    TComponentFactory.Create(ComServer, TReadFromDatabase,
        Class_ReadFromDatabase, ciMultiInstance, tmBoth);
end.

先记录下来，过段时间再回头研究到底是什么问题。