【delphi开源代码栏目提醒】:网学会员鉴于大家对delphi开源代码十分关注,论文会员在此为大家搜集整理了“LogisticsServer_Unit.pas”一文,供大家参考学习
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.
上一篇:
GLOBALDOC.CPP
下一篇:
哈弗F7 VS名爵HS,谁更懂得年轻人的心?