logisticsserver_unit.pas

货源代理管理系统 同样是DELPHI7下的

unit LogisticsServer_Unit;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr, ComCtrls, Controls,
  DBClient, Server_TLB, StdVcl, DB, ADODB, Provider, INIFiles, Dialogs, Forms;

type
  TLogisticsServer = class(TRemoteDataModule, ILogisticsServer)
    dspUser: TDataSetProvider;
    dsUserSet: TADODataSet;
    dsFeeType: TADODataSet;
    dspFeeType: TDataSetProvider;
    dspAreaType: TDataSetProvider;
    dsAreaType: TADODataSet;
    dsCallingType: TADODataSet;
    dspCallingType: TDataSetProvider;
    dsInsuranceType: TADODataSet;
    dspInsuranceType: TDataSetProvider;
    dsPersonnelType: TADODataSet;
    dspPersonnelType: TDataSetProvider;
    dsPaymentType: TADODataSet;
    dspPaymentType: TDataSetProvider;
    dsPerson: TADODataSet;
    dspPerson: TDataSetProvider;
    dsCustomer: TADODataSet;
    dspCustomer: TDataSetProvider;
    dsCarType: TADODataSet;
    dspCarType: TDataSetProvider;
    dsCar: TADODataSet;
    dspCar: TDataSetProvider;
    qryUpdatePassword: TADOQuery;
    dsShippingHeader: TADODataSet;
    dspShippingHeader: TDataSetProvider;
    dsShippingBody: TADODataSet;
    dspShippingBody: TDataSetProvider;
    qryUpdateItems: TADOQuery;
    dsrShippingHeader: TDataSource;
  private

  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function GetLogin(const LoginID, Password: WideString): WordBool; safecall;
    function GetMaxID(const TableName, FieldName,
      TypeStr: WideString): WideString; safecall;
    function GetBool(const CarNumber, TableName,
      FieldName: WideString): WordBool; safecall;
    procedure UpdatePassword(const LoginID, OldPad, NewPad,
      NewPad2: WideString); safecall;
    procedure GetClientInfo(const IP, ComputerName, LoginID: WideString);
      safecall;
    procedure GetItems(const ShipNumber, MaxID: WideString); safecall;
  public
    { Public declarations }
  end;

implementation

uses ServerMain_Unit;

{$R *.DFM}

class procedure TLogisticsServer.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 TLogisticsServer.GetLogin(const LoginID,
  Password: WideString): WordBool;
var
  LoginSQL: string;
begin
  LoginSQL := 'Select * From UserInfo where LoginID = '
            + QuotedStr(LoginID) + ' and Password = ' + QuotedStr(Password);
  with dsUserSet do
  begin
    Active := False;
    CommandText := LoginSQL;
    Active := True;
    if RecordCount > 0 then
      Result := True
    else
      Result := False;
  end;
end;


function TLogisticsServer.GetMaxID(const TableName, FieldName,
  TypeStr: WideString): WideString;
var
  MaxIDSQL, MaxID: string;
begin
  MaxIDSQL := 'Select ISNULL(Max(' + FieldName + '),' + TypeStr +') + 1 as MaxID From ' + TableName;
  with dsPerson do
  begin
    Close;
    CommandText := MaxIDSQL;
    Open;
  end;
  MaxID := dsPerson.FieldByName('MaxID').AsString;
  Result := MaxID;
end;

function TLogisticsServer.GetBool(const CarNumber, TableName,
  FieldName: WideString): WordBool;
var
  BoolSQL: string;
begin
  BoolSQL := 'Select * From ' + TableName + ' where ' + FieldName + ' = ' + QuotedStr(CarNumber);
  with dsCar do
  begin
    Close;
    CommandText := BoolSQL;
    Open;
    if dsCar.IsEmpty then
      Result := False
    else
      Result := True;
  end;
end;

procedure TLogisticsServer.UpdatePassword(const LoginID, OldPad, NewPad,
  NewPad2: WideString);
var
  SelectSQL, UpdateSQL: string;
begin
  SelectSQL := 'Select * from UserInfo where LoginID ='
             + QuotedStr(LoginID)
             + ' and Password = '
             + QuotedStr(OldPad);
  UpdateSQL := 'Update UserInfo set Password = '
             + QUotedStr(NewPad)
             + ' where LoginID = '
             + QuotedStr(LoginID);
  with dsUserSet do
  begin
    Close;
    CommandText := SelectSQL;
    Open;
    if dsUserSet.IsEmpty then
    begin
      ShowMEssage('原始密码错误');
    end else
    begin
      if NewPad <> NewPad2 then
      begin
        ShowMessage('两次输入的密码不相同!');
        Exit;
      end;
      with qryUpdatePassword do
      begin
        Close;
        SQL.Clear;
        SQL.Add(UpdateSQL);
        ExecSQL;
      end;
      ShowMEssage('修改密码成功!');
    end;
  end;
end;

procedure TLogisticsServer.GetClientInfo(const IP, ComputerName,
  LoginID: WideString);
var
  ListItem: TListItem;
begin
  ListItem := frmMainServer.ListView1.Items.Add;
  ListItem.Caption := IP;
  ListItem.SubItems.Add(LoginID);
  ListItem.SubItems.Add(DateToStr(Now));
  ListItem.SubItems.Add(ComputerName);
end;

procedure TLogisticsServer.GetItems(const ShipNumber, MaxID: WideString);
var
  UpdateItems: string;
begin
  UpdateItems := 'Update ShippingBillHeader set NextItemID=' + Quotedstr(MaxID)
                +' where ShippingNumber=' + Quotedstr(ShipNumber);
  with qryUpdateItems do
  begin
    Close;
    SQL.Clear;
    SQL.Add(UpdateItems);
    ExecSQL;
  end;
end;

initialization
  TComponentFactory.Create(ComServer, TLogisticsServer,
    Class_LogisticsServer, ciMultiInstance, tmApartment);
end.